Subversion Repositories DIN Is Noise

/*
* tcl_interp.cc
* DIN Is Noise is copyright (c) 2006-2025 Jagannathan Sampath
* DIN Is Noise is released under GNU Public License 2.0
* For more information, please visit https://dinisnoise.org/
*/

#include "tokenizer.h"
#include "command.h"
#include "tcl_interp.h"
#include "log.h"

#include <fstream>
#include <stdlib.h>
#include <stdint.h>

using namespace std;

extern cmdlist cmdlst;
extern double MIDI_BPM, TAP_BPM, TIME_NOW;
extern float VOLUME;
extern int doublebpm;

extern char BUFFER [];

void add_commands (Tcl_Interp* ti);

int tcl_run (ClientData cd, Tcl_Interp* ti, int objc, Tcl_Obj* CONST objv[]) {
  command* cmdp = cmdlst.cmds [(uintptr_t) cd];
  if (cmdp) {
    cmdlst.result = "";
    tokenizer tz;
    if (objc > 1) {
      vector<string> args;
      args.reserve (objc);
      for (int i = 1; i < objc; ++i) args.push_back (Tcl_GetString(objv[i]));
      tz.vec (args);
    } else {
      tz.str (Tcl_GetString(objv[0]));
    }
    cmdp->operator() (tz);
    Tcl_SetResult (ti, (char *) cmdlst.result.c_str(), TCL_STATIC);
  }

  return 0;
}

tcl_interp::tcl_interp () {
  result_status = TCL_OK;
  interp = Tcl_CreateInterp ();
  if (!interp) {
    dlog << "!!! could not create Tcl interpreter !!!" << endl;
    exit (1);
  } else {
    int ret = Tcl_Init (interp);
    dlog << "!!! init TCL interpreter: " << " OK = " << (ret == TCL_OK) << spc << " ERROR = " << (ret == TCL_ERROR) << " !!!" << endl;

#ifdef __GPL20__
    sprintf (BUFFER, "source %s/share/din/factory/setup-user-dir.tcl; make-user-dir %s", PREFIX, PREFIX);
    operator() (BUFFER);
#else
    sprintf (BUFFER, "%s", "source factory/setup-user-dir.tcl; make-user-dir");
    operator () (BUFFER);
#endif
    const string p3 (" +++ ");
    dlog << "+++ ran script : " << BUFFER << p3 << endl;
    dlog << "+++ created Tcl interpreter, user dir = " << result << p3  << endl;
  }
}

void tcl_interp::add_din_specific () {
  add_commands (interp);
  Tcl_LinkVar (interp, "midibpm", (char *) &MIDI_BPM, TCL_LINK_DOUBLE);
  Tcl_LinkVar (interp, "tapbpm", (char *) &TAP_BPM, TCL_LINK_DOUBLE);
  Tcl_LinkVar (interp, "timenow", (char *) &TIME_NOW, TCL_LINK_DOUBLE);
  Tcl_LinkVar (interp, "volume", (char *) &VOLUME, TCL_LINK_FLOAT);
  Tcl_LinkVar (interp, "doublebpm", (char *) &doublebpm, TCL_LINK_INT);
}

tcl_interp& tcl_interp::operator () (const string& cmd) {
  Tcl_Obj* script = Tcl_NewStringObj (cmd.c_str(), -1);
  Tcl_IncrRefCount (script);
    result_status = Tcl_EvalObjEx (interp, script, 0);
  Tcl_DecrRefCount (script);
  result = Tcl_GetStringResult (interp);
  return *this;
}

tcl_interp::~tcl_interp () {
  if (interp) {
    Tcl_UnlinkVar (interp, "midibpm");
    Tcl_UnlinkVar (interp, "tapbpm");
    Tcl_UnlinkVar (interp, "timenow");
    Tcl_UnlinkVar (interp, "volume");
    Tcl_UnlinkVar (interp, "doublebpm");
    Tcl_DeleteInterp (interp);
    dlog << "--- destroyed Tcl interpreter ---" << endl;
    dlog.flush ();
  }
}