enum MqErrorE NS(ProcCall) (
struct MqS * const mqctx,
MQ_PTR const dataP
)
{
SETUP_tclctx
SETUP_interp
Tcl_Obj *lobjv[2];
int ret;
Tcl_Obj *proc = (Tcl_Obj*) dataP;
// 0. clean all old errors
//Tcl_ResetResult(interp);
// the "BqError" have to survive the following line -> skip it
//MqErrorReset(mqctx);
// 1. add service handler
lobjv[0] = proc;
// 2. setup Command (e.g. the ContextS)
lobjv[1] = ((Tcl_Obj*)tclctx->mqctx.self);
// 3. evaluate the script
Tcl_IncrRefCount(lobjv[0]);
Tcl_IncrRefCount(lobjv[1]);
ret = Tcl_EvalObjv (interp, 2, lobjv, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(lobjv[1]);
Tcl_DecrRefCount(lobjv[0]);
return ret == TCL_OK ? Tcl_ResetResult(interp),MqErrorGetCodeI(mqctx) : NS(ProcError) (tclctx, "ErrorSet");
}
//-----------------------------------------------------------------------
extern "C" int If_SetInt(const char *name, int val)
{
if (!theInterp)
return IF_ERROR;
#if 0
// unfortunately Tcl_EvalObjv was not available under Tcl 8.0
Tcl_Obj *objv[2];
objv[0] = Tcl_NewStringObj((char *)name, -1);
objv[1] = Tcl_NewIntObj(val);
int retcode;
retcode = Tcl_EvalObjv(theInterp, 2, objv, 0);
Tcl_DecrRefCount(objv[0]);
Tcl_DecrRefCount(objv[1]);
if (retcode != TCL_OK)
return IF_ERROR;
#else
char valstr[50];
sprintf(valstr, "%d", val);
if (Tcl_VarEval(theInterp, (char *)name, " ", valstr, NULL) != TCL_OK)
return IF_ERROR;
#endif
Tcl_ResetResult(theInterp); // reset result as val was accepted
return IF_OK;
}
static Tcl_Obj*
getImageCompressed(HtmlImage2 *pImage)
{
if (!pImage->pCompressed) {
Tcl_Interp *interp = pImage->pImageServer->pTree->interp;
Tcl_Obj *apObj[3];
apObj[0] = pImage->pImageName;
apObj[1] = Tcl_NewStringObj("cget", -1);
apObj[2] = Tcl_NewStringObj("-data", -1);
Tcl_IncrRefCount(apObj[0]);
Tcl_IncrRefCount(apObj[1]);
Tcl_IncrRefCount(apObj[2]);
if (TCL_OK == Tcl_EvalObjv(interp, 3, apObj, TCL_EVAL_GLOBAL)) {
int nData;
Tcl_Obj *pData = Tcl_GetObjResult(interp);
Tcl_GetByteArrayFromObj(pData, &nData);
if (nData>0){
pImage->pCompressed = pData;
Tcl_IncrRefCount(pData);
}
}
Tcl_DecrRefCount(apObj[2]);
Tcl_DecrRefCount(apObj[1]);
Tcl_DecrRefCount(apObj[0]);
}
return pImage->pCompressed;
}
SEXP dotTclObjv(SEXP args)
{
SEXP t,
avec = CADR(args),
nm = getAttrib(avec, R_NamesSymbol);
int objc, i, result;
Tcl_Obj **objv;
const void *vmax = vmaxget();
for (objc = 0, i = 0; i < length(avec); i++){
if (!isNull(VECTOR_ELT(avec, i)))
objc++;
if (!isNull(nm) && strlen(translateChar(STRING_ELT(nm, i))))
objc++;
}
objv = (Tcl_Obj **) R_alloc(objc, sizeof(Tcl_Obj *));
for (objc = i = 0; i < length(avec); i++){
const char *s;
char *tmp;
if (!isNull(nm) && strlen(s = translateChar(STRING_ELT(nm, i)))){
tmp = calloc(strlen(s)+2, sizeof(char));
*tmp = '-';
strcpy(tmp+1, s);
objv[objc++] = Tcl_NewStringObj(tmp, -1);
free(tmp);
}
if (!isNull(t = VECTOR_ELT(avec, i)))
objv[objc++] = (Tcl_Obj *) R_ExternalPtrAddr(t);
}
for (i = objc; i--; ) Tcl_IncrRefCount(objv[i]);
result = Tcl_EvalObjv(RTcl_interp, objc, objv, 0);
for (i = objc; i--; ) Tcl_DecrRefCount(objv[i]);
if (result == TCL_ERROR)
{
char p[512];
if (strlen(Tcl_GetStringResult(RTcl_interp)) > 500)
strcpy(p, _("tcl error.\n"));
else {
char *res;
Tcl_DString res_ds;
Tcl_DStringInit(&res_ds);
res = Tcl_UtfToExternalDString(NULL,
Tcl_GetStringResult(RTcl_interp),
-1, &res_ds);
snprintf(p, sizeof(p), "[tcl] %s.\n", res);
Tcl_DStringFree(&res_ds);
}
error(p);
}
SEXP res = makeRTclObject(Tcl_GetObjResult(RTcl_interp));
vmaxset(vmax);
return res;
}
static void tvfsExecTcl(
Testvfs *p,
const char *zMethod,
Tcl_Obj *arg1,
Tcl_Obj *arg2,
Tcl_Obj *arg3
){
int rc; /* Return code from Tcl_EvalObj() */
int nArg; /* Elements in eval'd list */
int nScript;
Tcl_Obj ** ap;
assert( p->pScript );
if( !p->apScript ){
int nByte;
int i;
if( TCL_OK!=Tcl_ListObjGetElements(p->interp, p->pScript, &nScript, &ap) ){
Tcl_BackgroundError(p->interp);
Tcl_ResetResult(p->interp);
return;
}
p->nScript = nScript;
nByte = (nScript+TESTVFS_MAX_ARGS)*sizeof(Tcl_Obj *);
p->apScript = (Tcl_Obj **)ckalloc(nByte);
memset(p->apScript, 0, nByte);
for(i=0; i<nScript; i++){
p->apScript[i] = ap[i];
}
}
p->apScript[p->nScript] = Tcl_NewStringObj(zMethod, -1);
p->apScript[p->nScript+1] = arg1;
p->apScript[p->nScript+2] = arg2;
p->apScript[p->nScript+3] = arg3;
for(nArg=p->nScript; p->apScript[nArg]; nArg++){
Tcl_IncrRefCount(p->apScript[nArg]);
}
rc = Tcl_EvalObjv(p->interp, nArg, p->apScript, TCL_EVAL_GLOBAL);
if( rc!=TCL_OK ){
Tcl_BackgroundError(p->interp);
Tcl_ResetResult(p->interp);
}
for(nArg=p->nScript; p->apScript[nArg]; nArg++){
Tcl_DecrRefCount(p->apScript[nArg]);
p->apScript[nArg] = 0;
}
}
stf_status tpm_call_it(Tcl_Obj **objv, int objc)
{
int ret;
const char *res;
passert(objc>=4);
DBG(DBG_CONTROLMORE, DBG_log("TPM call %s %s %s %s %s"
, Tcl_GetString(objv[0])
, Tcl_GetString(objv[1])
, Tcl_GetString(objv[2])
, Tcl_GetString(objv[3])
, objc>4 ? Tcl_GetString(objv[4]) : ""));
ret = Tcl_EvalObjv(PlutoInterp, objc, objv, TCL_EVAL_GLOBAL);
res = Tcl_GetStringResult(PlutoInterp);
DBG(DBG_CONTROL, DBG_log("TPM %s(%s,%s,%s,%s) => %s"
, Tcl_GetString(objv[0])
, Tcl_GetString(objv[1])
, Tcl_GetString(objv[2])
, Tcl_GetString(objv[3])
, objc>4 ? Tcl_GetString(objv[4]) : ""
, res));
if(strcmp(res, "ignore")==0 || strcmp(res, "nothing")==0 || res[0]=='\0') {
/* just quietly return */
return STF_OK;
}
libreswan_log("TPM result: %s",res);
if(ret != TCL_OK) {
libreswan_log("TPM result failed");
}
if(strcmp(res, "stf_stolen")==0) {
return STF_STOLEN;
}
if(strcmp(res, "stf_ignore")==0) {
return STF_IGNORE;
}
return STF_OK;
}
/*
* Invoke the command for the specified virtual table with the additional
* args passed in. Note the additional arg objs are unref'ed eventually so
* caller must protect them with ref counts if they accessed on return.
*/
static int VTableInvokeCmd(Tcl_Interp *interp, VTableInfo *vtabP,
const char *command, int argobjc, Tcl_Obj **argobjv)
{
Tcl_Obj *objv[32];
Tcl_Obj **prefix;
int nprefix;
int objc;
int i;
int status;
Tcl_ListObjGetElements(interp, vtabP->cmdprefixP, &nprefix, &prefix);
objc = nprefix + 1 + 1 + argobjc;
if (objc > (sizeof(objv)/sizeof(objv[0]))) {
Tcl_SetResult(interp, "Exceeded limit on number of arguments allowed for virtual table method", TCL_STATIC);
return TCL_ERROR;
}
for (i = 0 ; i < nprefix; ++i) {
objv[i] = prefix[i];
Tcl_IncrRefCount(objv[i]);
}
/* Tack on method such as "update" */
objv[nprefix] = Tcl_NewStringObj(command, -1);
Tcl_IncrRefCount(objv[nprefix]);
/* Tack on virtual table handle */
objv[nprefix+1] = vtabP->vthandleP;
Tcl_IncrRefCount(objv[nprefix+1]);
nprefix += 2;
/* Finally, extra arguments */
for (i = 0; i < argobjc; ++i) {
objv[i + nprefix] = argobjv[i];
Tcl_IncrRefCount(argobjv[i]);
}
status = Tcl_EvalObjv(interp, objc, objv, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
for (i = 0; i < objc; ++i) {
Tcl_DecrRefCount(objv[i]);
}
return status;
}
char*
completion_generator(const char* text, int state)
{
const char* match = NULL;
if (completion_interp && generator_word) {
Tcl_Obj* objv[4];
objv[0] = generator_word;
objv[1] = Tcl_NewStringObj(text, -1);
objv[2] = Tcl_NewIntObj(state);
objv[3] = NULL;
if (TCL_OK == Tcl_EvalObjv(completion_interp, 3, objv, TCL_EVAL_DIRECT)) {
match = Tcl_GetStringResult(completion_interp);
}
}
return (match && *match) ? strdup(match) : NULL;
}
int
TkBackgroundEvalObjv(
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv,
int flags)
{
Tcl_InterpState state;
int n, r = TCL_OK;
/*
* Record the state of the interpreter.
*/
Tcl_Preserve(interp);
state = Tcl_SaveInterpState(interp, TCL_OK);
/*
* Evaluate the command and handle any error.
*/
for (n = 0; n < objc; ++n) {
Tcl_IncrRefCount(objv[n]);
}
r = Tcl_EvalObjv(interp, objc, objv, flags);
for (n = 0; n < objc; ++n) {
Tcl_DecrRefCount(objv[n]);
}
if (r == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (background event handler)");
Tcl_BackgroundException(interp, r);
}
/*
* Restore the state of the interpreter.
*/
(void) Tcl_RestoreInterpState(interp, state);
Tcl_Release(interp);
return r;
}
static int
resolveTypes(Tcl_Interp *interp) {
Tcl_Obj *objv[6];
Tcl_Obj *list;
Tcl_Obj *dict;
// определение типа lambdaExpr
objv[0]=Tcl_NewStringObj("apply",-1);
objv[1]=Tcl_NewStringObj("x { expr $x + 1}",-1);
objv[2]=Tcl_NewIntObj(1),-1;
Tcl_IncrRefCount(objv[0]);
Tcl_IncrRefCount(objv[1]);
Tcl_IncrRefCount(objv[2]);
if (Tcl_EvalObjv(interp,3,objv,0)!=TCL_OK) {
ERR("in call apply");
INSPECT_ARRAY(-1,3,objv,"command");
return TCL_ERROR;
}
cmdNameType=objv[0]->typePtr;
lambdaExprType=objv[1]->typePtr;
// определение типа List
list=Tcl_NewListObj(3,objv);
listType=list->typePtr;
if (listType==NULL || listType->name==NULL || listType->name[0]=='\0') {
ERR("in resolve listType");
return TCL_ERROR;
}
Tcl_DecrRefCount(list);
Tcl_DecrRefCount(objv[0]);
Tcl_DecrRefCount(objv[1]);
Tcl_DecrRefCount(objv[2]);
// определение типа dict
dict=Tcl_NewDictObj();
if (dict==NULL || dict->typePtr==NULL) {
ERR("in resolve dictType");
return TCL_ERROR;
}
dictType=dict->typePtr;
return TCL_OK;
}
static int InitNullValueForDB(Tcl_Interp *interp, VTableDB *vtdbP)
{
Tcl_Obj *objv[2];
int status;
objv[0] = vtdbP->dbcmd_objP; /* No need to IncrRef this as vtdbP
already ensures that */
objv[1] = Tcl_NewStringObj("nullvalue", -1);
Tcl_IncrRefCount(objv[1]);
status = Tcl_EvalObjv(interp, 2, objv, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(objv[1]);
if (status == TCL_ERROR)
return TCL_ERROR;
if (vtdbP->null_objP)
Tcl_DecrRefCount(vtdbP->null_objP);
vtdbP->null_objP = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(vtdbP->null_objP);
return TCL_OK;
}
static PyObject *
Tkapp_Call(PyObject *self, PyObject *args)
{
Tcl_Obj *objStore[ARGSZ];
Tcl_Obj **objv = NULL;
int objc = 0, i;
PyObject *res = NULL;
Tcl_Interp *interp = Tkapp_Interp(self);
/* Could add TCL_EVAL_GLOBAL if wrapped by GlobalCall... */
int flags = TCL_EVAL_DIRECT;
objv = objStore;
if (args == NULL)
objc = 0;
else if (!PyTuple_Check(args)) {
objc = 1;
objv[0] = AsObj(args);
if (objv[0] == 0)
goto finally;
Tcl_IncrRefCount(objv[0]);
}
else {
objc = PyTuple_Size(args);
if (objc > ARGSZ) {
objv = (Tcl_Obj **)ckalloc(objc * sizeof(char *));
if (objv == NULL) {
PyErr_NoMemory();
goto finally;
}
}
for (i = 0; i < objc; i++) {
PyObject *v = PyTuple_GetItem(args, i);
if (v == Py_None) {
objc = i;
break;
}
objv[i] = AsObj(v);
if (!objv[i])
goto finally;
Tcl_IncrRefCount(objv[i]);
}
}
ENTER_TCL
i = Tcl_EvalObjv(interp, objc, objv, flags);
ENTER_OVERLAP
if (i == TCL_ERROR)
Tkinter_Error(self);
else {
/* We could request the object result here, but doing
so would confuse applications that expect a string. */
char *s = Tcl_GetStringResult(interp);
char *p = s;
/* If the result contains any bytes with the top bit set,
it's UTF-8 and we should decode it to Unicode */
while (*p != '\0') {
if (*p & 0x80)
break;
p++;
}
if (*p == '\0')
res = PyString_FromStringAndSize(s, (int)(p-s));
else {
/* Convert UTF-8 to Unicode string */
p = strchr(p, '\0');
res = PyUnicode_DecodeUTF8(s, (int)(p-s), "strict");
if (res == NULL) {
PyErr_Clear();
res = PyString_FromStringAndSize(s, (int)(p-s));
}
}
}
LEAVE_OVERLAP_TCL
finally:
for (i = 0; i < objc; i++)
Tcl_DecrRefCount(objv[i]);
if (objv != objStore)
ckfree(FREECAST objv);
return res;
}
static int obj_Cgmap(ClientData /*UNUSED*/, Tcl_Interp *interp, int argc, Tcl_Obj * const objv[])
{
Tcl_Obj *atomselect = NULL;
Tcl_Obj *object = NULL;
Tcl_Obj *bytes = NULL;
Tcl_Obj *bytes_append = NULL;
Tcl_Obj *sel = NULL;
float *coords = NULL;
float *coords_append = NULL;
const char *blockid_field = "user";
const char *order_field = "user2";
const char *weight_field= "user3";
int nframes, natoms, ncoords, result, length;
int first, last, stride;
int molid, append_molid;
natoms = ncoords = result = 0;
molid = append_molid = 0;
first = last = 0;
stride = 1;
nframes = 1;
std::vector<float> weight;
std::vector<int> bead;
std::vector<int> index;
// Parse Arguments
int n = 1;
while (n < argc) {
const char *cmd = Tcl_GetString(objv[n]);
if (!strncmp(cmd, "-molid", 7)) {
if (Tcl_GetIntFromObj(interp,objv[n+1], &molid) != TCL_OK) {return TCL_ERROR;}
n += 2;
} else if (!strncmp(cmd, "-append", 8)) {
if (Tcl_GetIntFromObj(interp,objv[n+1], &append_molid) != TCL_OK) {return TCL_ERROR;}
n += 2;
} else if (!strncmp(cmd, "-sel", 5)) {
sel = objv[n+1];
n += 2;
} else if (!strncmp(cmd, "-first", 5)) {
if (Tcl_GetIntFromObj(interp,objv[n+1], &first) != TCL_OK) {return TCL_ERROR;}
n += 2;
} else if (!strncmp(cmd, "-last", 4)) {
if (Tcl_GetIntFromObj(interp,objv[n+1], &last) != TCL_OK) {return TCL_ERROR;}
n += 2;
} else if (!strncmp(cmd, "-stride", 6)) {
if (Tcl_GetIntFromObj(interp,objv[n+1], &stride) != TCL_OK) {return TCL_ERROR;}
n += 2;
} else if (!strncmp(cmd, "-weight", 7)) {
weight_field = Tcl_GetString(objv[n+1]);
n += 2;
} else if (!strncmp(cmd, "-blockid", 7)) {
blockid_field = Tcl_GetString(objv[n+1]);
n += 2;
} else if (!strncmp(cmd, "-order", 6)) {
order_field = Tcl_GetString(objv[n+1]);
n += 2;
} else {
Tcl_WrongNumArgs(interp,1,objv, (char *)"molid");
return TCL_ERROR;
}
}
// Create an internal selection that we can manipulate if none was defined
// Note that a passed selection overides the passed molid
if (!sel) {
Tcl_Obj *script = Tcl_ObjPrintf("atomselect %i all", molid);
if (Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error calling atomselect", TCL_STATIC);
return TCL_ERROR;
}
atomselect = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(atomselect);
} else {
// Create a internal selection that is a COPY of the passed selection
atomselect = Tcl_DuplicateObj(sel);
Tcl_IncrRefCount(atomselect);
// Get the molid
Tcl_Obj *script = Tcl_DuplicateObj(sel);
Tcl_AppendToObj(script, " molid", -1);
if(Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error calling atomselect", TCL_STATIC);
return TCL_ERROR;
}
Tcl_Obj *molid_result = Tcl_GetObjResult(interp);
if (Tcl_GetIntFromObj(interp, molid_result, &molid) != TCL_OK) {return TCL_ERROR;}
}
// Get the number of frames
Tcl_Obj *script = Tcl_ObjPrintf("molinfo %i get numframes", molid);
if (Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error calling molinfo for nframes", TCL_STATIC);
return TCL_ERROR;
}
object = Tcl_GetObjResult(interp);
if (Tcl_GetIntFromObj(interp, object, &nframes) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error parsing number of frames", TCL_STATIC);
return TCL_ERROR;
}
if ( first < 0 || first >= nframes ) {
Tcl_SetResult(interp, (char *) "Cgmap: illegal value of first_frame", TCL_STATIC);
return TCL_ERROR;
}
if ( last == -1 || last > nframes || last < first ) last = nframes;
// Get the number of atoms from selection
script = Tcl_DuplicateObj(atomselect);
Tcl_AppendToObj(script, " num", -1);
if (Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error calling atomselect", TCL_STATIC);
return TCL_ERROR;
}
object = Tcl_GetObjResult(interp);
if (Tcl_GetIntFromObj(interp, object, &natoms) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error parsing number of atoms", TCL_STATIC);
return TCL_ERROR;
}
// Make sure we actually have some atoms
if (natoms == 0) {
Tcl_SetResult(interp, (char *) "Cgmap: Selection or molecule contains no atoms", TCL_STATIC);
return TCL_ERROR;
}
// Get the weights (mass)
script = Tcl_DuplicateObj(atomselect);
Tcl_AppendPrintfToObj (script, " get %s", weight_field);
if (Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error calling atomselect for weights", TCL_STATIC);
return TCL_ERROR;
}
ncoords = parse_vector(Tcl_GetObjResult(interp), weight, interp);
if (ncoords == -1) {
Tcl_SetResult(interp, (char *) "Cgmap: error parsing atomselect result", TCL_STATIC);
return TCL_ERROR;
}
// Get the bead IDs
script = Tcl_DuplicateObj(atomselect);
Tcl_AppendPrintfToObj (script, " get %s", blockid_field);
if (Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error calling atomselect for blocks", TCL_STATIC);
return TCL_ERROR;
}
ncoords = parse_ivector(Tcl_GetObjResult(interp), bead, interp, true);
if (ncoords == -1) {
Tcl_SetResult(interp, (char *) "Cgmap: error parsing atomselect result", TCL_STATIC);
return TCL_ERROR;
}
// Get the atom IDs, we use these as a map when accessing the coordinate array
// user2 is set via ::CGit::setBeadID
script = Tcl_DuplicateObj(atomselect);
Tcl_AppendPrintfToObj (script, " get %s", order_field);
if (Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error calling atomselect for order", TCL_STATIC);
return TCL_ERROR;
}
ncoords = parse_ivector(Tcl_GetObjResult(interp), index, interp, true);
if (ncoords == -1) {
Tcl_SetResult(interp, (char *) "Cgmap: error parsing atomselect result", TCL_STATIC);
return TCL_ERROR;
}
// Get current frame of the target mol
script = Tcl_ObjPrintf("molinfo %d get frame", append_molid);
if (Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error getting append mol's current frame", TCL_STATIC);
return TCL_ERROR;
}
int append_frame = 0;
object = Tcl_GetObjResult(interp);
if (Tcl_GetIntFromObj(interp, object, &append_frame) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error parsing append mol's current frame", TCL_STATIC);
return TCL_ERROR;
}
//Get number of atoms in target (append) mol
script = Tcl_ObjPrintf("molinfo %i get numatoms", append_molid);
if (Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error getting append mol's number of atoms", TCL_STATIC);
return TCL_ERROR;
}
int append_natoms = 0;
object = Tcl_GetObjResult(interp);
if (Tcl_GetIntFromObj(interp, object, &append_natoms) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error parsing append mol's number of atoms", TCL_STATIC);
return TCL_ERROR;
}
int print = ((last - first) / 10);
if (print < 10) print = 10;
if (print > 100) print = 100;
//Loop over frames, calculate COMS, set coordinates in target mol
for (int frame = first;
frame <= last && frame < nframes;
frame += stride) {
if (frame % print == 0) {
//Tcl_Obj *msg = Tcl_ObjPrintf ("puts \"Mapping frame %i\"", frame);
Tcl_Obj *msg = Tcl_ObjPrintf ("vmdcon -info \"CGit> Mapping frame %i\"", frame);
result = Tcl_EvalObjEx(interp, msg, TCL_EVAL_DIRECT);
if (result != TCL_OK) { return TCL_ERROR; }
}
//Update the frames
Tcl_Obj *mol_chgframe = Tcl_ObjPrintf ("molinfo top set frame %i", frame);
if (Tcl_EvalObjEx(interp, mol_chgframe, TCL_EVAL_DIRECT) != TCL_OK)
return TCL_ERROR;
// Get the coordinates of the molecules in the reference mol
Tcl_Obj *get_ts = Tcl_ObjPrintf("gettimestep %d %i", molid, frame);
if (Tcl_EvalObjEx(interp, get_ts, TCL_EVAL_DIRECT) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error getting coordinates", TCL_STATIC);
return TCL_ERROR;
}
bytes = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(bytes);
Tcl_InvalidateStringRep (bytes);
coords = reinterpret_cast<float *> (Tcl_GetByteArrayFromObj(bytes, &length));
/** Create a new frame for append_mol **/
Tcl_ObjPrintf("animate dup %i", append_molid);
if (Tcl_EvalObjEx(interp, get_ts, TCL_EVAL_DIRECT) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error adding frame to append mol", TCL_STATIC);
return TCL_ERROR;
}
append_frame++;
Tcl_Obj *setframe = Tcl_ObjPrintf("molinfo %i set frame %i; display update", molid, frame);
if (Tcl_EvalObjEx(interp, setframe, TCL_EVAL_DIRECT) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error updating source frame", TCL_STATIC);
return TCL_ERROR;
}
// Copy PBC conditions
Tcl_Obj *setpbc = Tcl_ObjPrintf("molinfo %i set {a b c} [molinfo %i get {a b c}]", append_molid, molid);
if (Tcl_EvalObjEx(interp, setpbc, TCL_EVAL_DIRECT) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error updating PBC", TCL_STATIC);
return TCL_ERROR;
}
// Get the coordinates of the molecules in the target (append) mol
get_ts = Tcl_ObjPrintf("gettimestep %d %i", append_molid, append_frame);
if (Tcl_EvalObjEx(interp, get_ts, TCL_EVAL_DIRECT) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error getting coordinates", TCL_STATIC);
return TCL_ERROR;
}
bytes_append = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(bytes_append);
Tcl_InvalidateStringRep(bytes_append);
coords_append = reinterpret_cast<float *> (Tcl_GetByteArrayFromObj(bytes_append, &length));
//loop over coordinates and beads, calculate COMs
int current_bead, current_atom;
current_bead = current_atom = 0;
// Nested loop to work on each bead at a time
float w,x,y,z;
int j = 0;
for (int start_atom = 0; start_atom < natoms; ) {
current_bead = bead[start_atom];
w = x = y = z = 0;
// Calculate COM for each bead
for ( current_atom = start_atom;
current_atom < natoms && bead[current_atom] == current_bead;
current_atom++) {
//Lookup the atom index from the selection
unsigned int idx = index[current_atom];
float tw = weight[current_atom];
w += tw;
x += tw * coords[3*idx];
y += tw * coords[3*idx+1];
z += tw * coords[3*idx+2];
}
if (w == 0) {
Tcl_SetResult(interp, (char *) "Cgmap: Bad weight can't total zero", TCL_STATIC);
return TCL_ERROR;
}
// Insert calculated COMS into append_mols coordinate array
// Need to figure out some kind of bounds checking here...
coords_append[3 * j ] = x / w;
coords_append[3 * j + 1] = y / w;
coords_append[3 * j + 2] = z / w;
start_atom = current_atom;
j++;
} // bead loop
// call rawtimestep to set byte array for append_mol
Tcl_Obj *set_ts[5];
set_ts[0] = Tcl_NewStringObj("rawtimestep", -1);
set_ts[1] = Tcl_ObjPrintf("%d",append_molid);
set_ts[2] = bytes_append;
set_ts[3] = Tcl_NewStringObj("-frame", -1);
set_ts[4] = Tcl_NewIntObj(append_frame);
if (Tcl_EvalObjv (interp, 5, set_ts, 0) != TCL_OK)
return TCL_ERROR;
//Cleanup
Tcl_DecrRefCount(bytes);
Tcl_DecrRefCount(bytes_append);
} // Frame loop
//Cleanup
Tcl_DecrRefCount(atomselect);
Tcl_SetResult(interp, (char *) "", TCL_STATIC);
return TCL_OK;
}
void ics_tcl_handler(struct ics_server *ics, struct ics_trigger *trig, struct ics_data *data)
{
int ret;
Tcl_Obj *command;
Tcl_Obj *ics_label;
Tcl_Obj *who;
Tcl_Obj *action;
Tcl_Obj *message;
Tcl_Obj *sender;
Tcl_Obj *game_id;
Tcl_Obj *white;
Tcl_Obj *black;
Tcl_Obj *winner;
Tcl_Obj *loser;
Tcl_Obj *result;
Tcl_Obj *style12;
Tcl_Obj *initial_time;
Tcl_Obj *time_increment;
Tcl_Obj **objv;
char *hackpad;
size_t hackpad_len;
switch (trig->type)
{
/* alecmao(U) tells you: hi */
case ICS_TRIG_TELL:
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
ics_label = Tcl_NewStringObj(ics->label, strlen(ics->label));
for (hackpad_len=0; data->tokens[0][hackpad_len] != '\0' && data->tokens[0][hackpad_len] != '('; hackpad_len++);
hackpad = tmalloc0(hackpad_len + 1);
strncpy(hackpad, data->tokens[0], hackpad_len);
sender = Tcl_NewStringObj(hackpad, strlen(hackpad));
hackpad = &data->txt_packet[strlen(data->tokens[0]) + strlen(data->tokens[1]) + strlen(data->tokens[2]) + 3];
message = Tcl_NewStringObj(hackpad, strlen(hackpad));
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(ics_label);
Tcl_IncrRefCount(sender);
Tcl_IncrRefCount(message);
objv = tmalloc(sizeof(Tcl_Obj *) * 4);
objv[0] = command;
objv[1] = ics_label;
objv[2] = sender;
objv[3] = message;
ret = Tcl_EvalObjv(ics->tclinterp, 4, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(ics_label);
Tcl_DecrRefCount(sender);
Tcl_DecrRefCount(message);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(ics->tclinterp));
}
free(objv);
break;
/* <ICS Label> <game id> <white> <black> <winner> <loser> <result> <message> */
case ICS_TRIG_ENDGAME:
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
ics_label = Tcl_NewStringObj(ics->label, strlen(ics->label));
game_id = Tcl_NewIntObj(ics->game->game_number);
white = Tcl_NewStringObj(ics->game->white_name, strlen(ics->game->white_name));
black = Tcl_NewStringObj(ics->game->black_name, strlen(ics->game->black_name));
winner = Tcl_NewStringObj(ics->game->winner_name, strlen(ics->game->winner_name));
loser = Tcl_NewStringObj(ics->game->loser_name, strlen(ics->game->loser_name));
result = Tcl_NewStringObj(ics->game->end_result, strlen(ics->game->end_result));
message = Tcl_NewStringObj(ics->game->end_message, strlen(ics->game->end_message));
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(ics_label);
Tcl_IncrRefCount(game_id);
Tcl_IncrRefCount(white);
Tcl_IncrRefCount(black);
Tcl_IncrRefCount(winner);
Tcl_IncrRefCount(loser);
Tcl_IncrRefCount(result);
Tcl_IncrRefCount(message);
objv = tmalloc(sizeof(Tcl_Obj *) * 9);
objv[0] = command;
objv[1] = ics_label;
objv[2] = game_id;
objv[3] = white;
objv[4] = black;
objv[5] = winner;
objv[6] = loser;
objv[7] = result;
objv[8] = message;
ret = Tcl_EvalObjv(ics->tclinterp, 9, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(ics_label);
Tcl_DecrRefCount(game_id);
Tcl_DecrRefCount(white);
Tcl_DecrRefCount(black);
Tcl_DecrRefCount(winner);
Tcl_DecrRefCount(loser);
Tcl_DecrRefCount(result);
Tcl_DecrRefCount(message);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(ics->tclinterp));
}
free(objv);
break;
/* <ICS Label> <game id> <white> <black> <initial time> <time increment> */
case ICS_TRIG_GAME:
/* The proper way of doing things, according to #tcl on freenode (they'd know) */
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
ics_label = Tcl_NewStringObj(ics->label, strlen(ics->label));
game_id = Tcl_NewIntObj(ics->game->game_number);
white = Tcl_NewStringObj(ics->game->white_name, strlen(ics->game->white_name));
black = Tcl_NewStringObj(ics->game->black_name, strlen(ics->game->black_name));
initial_time = Tcl_NewIntObj(ics->game->initial_time);
time_increment = Tcl_NewIntObj(ics->game->increment_time);
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(ics_label);
Tcl_IncrRefCount(game_id);
Tcl_IncrRefCount(white);
Tcl_IncrRefCount(black);
Tcl_IncrRefCount(initial_time);
Tcl_IncrRefCount(time_increment);
objv = tmalloc(sizeof(Tcl_Obj *) * 7);
objv[0] = command;
objv[1] = ics_label;
objv[2] = game_id;
objv[3] = white;
objv[4] = black;
objv[5] = initial_time;
objv[6] = time_increment;
/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
ret = Tcl_EvalObjv(ics->tclinterp, 7, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(ics_label);
Tcl_DecrRefCount(game_id);
Tcl_DecrRefCount(white);
Tcl_DecrRefCount(black);
Tcl_DecrRefCount(initial_time);
Tcl_DecrRefCount(time_increment);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(ics->tclinterp));
}
free(objv);
break;
/* <ICS Label> <Message> */
case ICS_TRIG_MSG:
/* The proper way of doing things, according to #tcl on freenode (they'd know) */
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
ics_label = Tcl_NewStringObj(ics->label, strlen(ics->label));
message = Tcl_NewStringObj(data->txt_packet, strlen(data->txt_packet));
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(ics_label);
Tcl_IncrRefCount(message);
objv = tmalloc(sizeof(Tcl_Obj *) * 3);
objv[0] = command;
objv[1] = ics_label;
objv[2] = message;
/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
ret = Tcl_EvalObjv(ics->tclinterp, 3, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(ics_label);
Tcl_DecrRefCount(message);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(ics->tclinterp));
}
free(objv);
break;
case ICS_TRIG_CONNECT:
/* The proper way of doing things, according to #tcl on freenode (they'd know) */
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
ics_label = Tcl_NewStringObj(ics->label, strlen(ics->label));
who = Tcl_NewStringObj(data->tokens[1], strlen(data->tokens[1]));
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(ics_label);
Tcl_IncrRefCount(who);
objv = tmalloc(sizeof(Tcl_Obj *) * 3);
objv[0] = command;
objv[1] = ics_label;
objv[2] = who;
/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
ret = Tcl_EvalObjv(ics->tclinterp, 3, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(ics_label);
Tcl_DecrRefCount(who);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(ics->tclinterp));
}
free(objv);
break;
case ICS_TRIG_MOVE:
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
ics_label = Tcl_NewStringObj(ics->label, strlen(ics->label));
style12 = Tcl_NewStringObj(ics->game->style_twelve, strlen(ics->game->style_twelve));
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(ics_label);
Tcl_IncrRefCount(style12);
/* I don't need a NULL last array element */
objv = tmalloc(sizeof(Tcl_Obj *) * 3);
objv[0] = command;
objv[1] = ics_label;
objv[2] = style12;
/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
ret = Tcl_EvalObjv(ics->tclinterp, 3, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(ics_label);
Tcl_DecrRefCount(style12);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(ics->tclinterp));
}
free(objv);
break;
case ICS_TRIG_NOTIFY:
/* The proper way of doing things, according to #tcl on freenode (they'd know) */
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
ics_label = Tcl_NewStringObj(ics->label, strlen(ics->label));
who = Tcl_NewStringObj(data->tokens[1], strlen(data->tokens[1]));
action = Tcl_NewStringObj(data->tokens[3], strlen(data->tokens[3]));
/* We need to increase the reference count, because if TCL suddenly gets some
* time for GC, it will notice a zero reference count
*/
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(ics_label);
Tcl_IncrRefCount(who);
Tcl_IncrRefCount(action);
/* I don't need a NULL last array element */
objv = tmalloc(sizeof(Tcl_Obj *) * 4);
objv[0] = command;
objv[1] = ics_label;
objv[2] = who;
objv[3] = action;
/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
ret = Tcl_EvalObjv(ics->tclinterp, 4, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(ics_label);
Tcl_DecrRefCount(who);
Tcl_DecrRefCount(action);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(ics->tclinterp));
}
free(objv);
break;
}
return;
}
/* This handles all triggers which have a handler of tcl, or was set that way through
* a bind in a TCL script.
*
* Rewritten to use the proper way, instead of doing that Tcl_ValEval() garbage.
*/
void tcl_handler(struct network *net, struct trigger *trig, struct irc_data *data, struct dcc_session *dcc, const char *dccbuf)
{
int ret;
char *my_arg;
Tcl_Obj *command;
Tcl_Obj *nick;
Tcl_Obj *uhost;
Tcl_Obj *hand;
Tcl_Obj *chan;
Tcl_Obj *arg;
Tcl_Obj *msg;
Tcl_Obj *from;
Tcl_Obj *keyword;
Tcl_Obj *text;
Tcl_Obj **objv;
switch (trig->type)
{
case TRIG_PUB:
/* The proper way of doing things, according to #tcl on freenode (they'd know) */
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
nick = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
uhost = Tcl_NewStringObj(data->prefix->host, strlen(data->prefix->host));
hand = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
chan = Tcl_NewStringObj(data->c_params[0], strlen(data->c_params[0]));
/* We do this because I'm retarded and have no way of figuring out what should happen after the mask */
my_arg = tstrdup(troll_makearg(data->rest_str,trig->mask));
arg = Tcl_NewStringObj(my_arg, strlen(my_arg));
/* We need to increase the reference count, because if TCL suddenly gets some
* time for GC, it will notice a zero reference count
*/
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(nick);
Tcl_IncrRefCount(uhost);
Tcl_IncrRefCount(hand);
Tcl_IncrRefCount(chan);
Tcl_IncrRefCount(arg);
/* I don't need a NULL last array element */
objv = tmalloc(sizeof(Tcl_Obj *) * 6);
objv[0] = command;
objv[1] = nick;
objv[2] = uhost;
objv[3] = hand;
objv[4] = chan;
objv[5] = arg;
/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
ret = Tcl_EvalObjv(net->tclinterp, 6, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(nick);
Tcl_DecrRefCount(uhost);
Tcl_DecrRefCount(hand);
Tcl_DecrRefCount(chan);
Tcl_DecrRefCount(arg);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
}
free(my_arg);
free(objv);
break;
case TRIG_PUBM:
/* The proper way of doing things, according to #tcl on freenode (they'd know) */
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
nick = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
uhost = Tcl_NewStringObj(data->prefix->host, strlen(data->prefix->host));
hand = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
chan = Tcl_NewStringObj(data->c_params[0], strlen(data->c_params[0]));
text = Tcl_NewStringObj(data->rest_str, strlen(data->rest_str));
/* We need to increase the reference count, because if TCL suddenly gets some
* time for GC, it will notice a zero reference count
*/
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(nick);
Tcl_IncrRefCount(uhost);
Tcl_IncrRefCount(hand);
Tcl_IncrRefCount(chan);
Tcl_IncrRefCount(text);
/* I don't need a NULL last array element */
objv = tmalloc(sizeof(Tcl_Obj *) * 6);
objv[0] = command;
objv[1] = nick;
objv[2] = uhost;
objv[3] = hand;
objv[4] = chan;
objv[5] = text;
/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
ret = Tcl_EvalObjv(net->tclinterp, 6, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(nick);
Tcl_DecrRefCount(uhost);
Tcl_DecrRefCount(hand);
Tcl_DecrRefCount(chan);
Tcl_DecrRefCount(text);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
}
free(objv);
break;
case TRIG_MSG:
/* The proper way of doing things, according to #tcl on freenode (they'd know) */
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
nick = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
uhost = Tcl_NewStringObj(data->prefix->host, strlen(data->prefix->host));
hand = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
/* This is stupid, I don't even remember why the hell I did this */
my_arg = ((&data->rest_str[strlen(trig->mask)] == NULL) || &data->rest_str[strlen(trig->mask)+1] == NULL) ? "" : &data->rest_str[strlen(trig->mask)+1];
text = Tcl_NewStringObj(my_arg, strlen(my_arg));
/* We need to increase the reference count, because if TCL suddenly gets some
* time for GC, it will notice a zero reference count
*/
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(nick);
Tcl_IncrRefCount(uhost);
Tcl_IncrRefCount(hand);
Tcl_IncrRefCount(text);
/* I don't need a NULL last array element */
objv = tmalloc(sizeof(Tcl_Obj *) * 5);
objv[0] = command;
objv[1] = nick;
objv[2] = uhost;
objv[3] = hand;
objv[4] = text;
/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
ret = Tcl_EvalObjv(net->tclinterp, 5, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(nick);
Tcl_DecrRefCount(uhost);
Tcl_DecrRefCount(hand);
Tcl_DecrRefCount(text);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
}
free(objv);
break;
case TRIG_MSGM:
/* The proper way of doing things, according to #tcl on freenode (they'd know) */
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
nick = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
uhost = Tcl_NewStringObj(data->prefix->host, strlen(data->prefix->host));
hand = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
/* This is stupid, I don't even remember why the hell I did this */
text = Tcl_NewStringObj(data->rest_str, strlen(data->rest_str));
/* We need to increase the reference count, because if TCL suddenly gets some
* time for GC, it will notice a zero reference count
*/
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(nick);
Tcl_IncrRefCount(uhost);
Tcl_IncrRefCount(hand);
Tcl_IncrRefCount(text);
/* I don't need a NULL last array element */
objv = tmalloc(sizeof(Tcl_Obj *) * 5);
objv[0] = command;
objv[1] = nick;
objv[2] = uhost;
objv[3] = hand;
objv[4] = text;
/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
ret = Tcl_EvalObjv(net->tclinterp, 5, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(nick);
Tcl_DecrRefCount(uhost);
Tcl_DecrRefCount(hand);
Tcl_DecrRefCount(text);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
}
free(objv);
break;
case TRIG_TOPC:
/* The proper way of doing things, according to #tcl on freenode (they'd know) */
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
nick = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
uhost = Tcl_NewStringObj(data->prefix->host, strlen(data->prefix->host));
hand = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
chan = Tcl_NewStringObj(data->c_params[0], strlen(data->c_params[0]));
text = Tcl_NewStringObj(data->rest_str, strlen(data->rest_str));
/* We need to increase the reference count, because if TCL suddenly gets some
* time for GC, it will notice a zero reference count
*/
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(nick);
Tcl_IncrRefCount(uhost);
Tcl_IncrRefCount(hand);
Tcl_IncrRefCount(chan);
Tcl_IncrRefCount(text);
/* I don't need a NULL last array element */
objv = tmalloc(sizeof(Tcl_Obj *) * 6);
objv[0] = command;
objv[1] = nick;
objv[2] = uhost;
objv[3] = hand;
objv[4] = chan;
objv[5] = text;
/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
ret = Tcl_EvalObjv(net->tclinterp, 6, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(nick);
Tcl_DecrRefCount(uhost);
Tcl_DecrRefCount(hand);
Tcl_DecrRefCount(chan);
Tcl_DecrRefCount(text);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
}
free(objv);
break;
case TRIG_RAW:
/* The proper way of doing things, according to #tcl on freenode (they'd know) */
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
from = Tcl_NewStringObj(data->c_params[0], strlen(data->c_params[0]));
keyword = Tcl_NewStringObj(trig->command, strlen(trig->command));
text = Tcl_NewStringObj(data->rest_str, strlen(data->rest_str));
/* We need to increase the reference count, because if TCL suddenly gets some
* time for GC, it will notice a zero reference count
*/
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(from);
Tcl_IncrRefCount(keyword);
Tcl_IncrRefCount(text);
/* I don't need a NULL last array element */
objv = tmalloc(sizeof(Tcl_Obj *) * 4);
objv[0] = command;
objv[1] = from;
objv[2] = keyword;
objv[3] = text;
/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
ret = Tcl_EvalObjv(net->tclinterp, 4, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(from);
Tcl_DecrRefCount(keyword);
Tcl_DecrRefCount(text);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
}
free(objv);
break;
/* :[email protected] JOIN :#test */
case TRIG_JOIN:
/* The proper way of doing things, according to #tcl on freenode (they'd know) */
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
nick = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
uhost = Tcl_NewStringObj(data->prefix->host, strlen(data->prefix->host));
hand = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
chan = Tcl_NewStringObj(data->rest_str, strlen(data->rest_str));
/* We need to increase the reference count, because if TCL suddenly gets some
* time for GC, it will notice a zero reference count
*/
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(nick);
Tcl_IncrRefCount(uhost);
Tcl_IncrRefCount(hand);
Tcl_IncrRefCount(chan);
/* I don't need a NULL last array element */
objv = tmalloc(sizeof(Tcl_Obj *) * 5);
objv[0] = command;
objv[1] = nick;
objv[2] = uhost;
objv[3] = hand;
objv[4] = chan;
/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
ret = Tcl_EvalObjv(net->tclinterp, 5, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(nick);
Tcl_DecrRefCount(uhost);
Tcl_DecrRefCount(hand);
Tcl_DecrRefCount(chan);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
}
free(objv);
break;
/* :[email protected] PART #boo :eat my shit */
case TRIG_PART:
/* The proper way of doing things, according to #tcl on freenode (they'd know) */
command = Tcl_NewStringObj(trig->command, strlen(trig->command));
nick = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
uhost = Tcl_NewStringObj(data->prefix->host, strlen(data->prefix->host));
hand = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
chan = Tcl_NewStringObj(data->c_params[0], strlen(data->c_params[0]));
msg = Tcl_NewStringObj(data->rest_str, strlen(data->rest_str));
/* We need to increase the reference count, because if TCL suddenly gets some
* time for GC, it will notice a zero reference count
*/
Tcl_IncrRefCount(command);
Tcl_IncrRefCount(nick);
Tcl_IncrRefCount(uhost);
Tcl_IncrRefCount(hand);
Tcl_IncrRefCount(chan);
Tcl_IncrRefCount(msg);
/* I don't need a NULL last array element */
objv = tmalloc(sizeof(Tcl_Obj *) * 6);
objv[0] = command;
objv[1] = nick;
objv[2] = uhost;
objv[3] = hand;
objv[4] = chan;
objv[5] = msg;
/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
ret = Tcl_EvalObjv(net->tclinterp, 6, objv, TCL_EVAL_GLOBAL);
/* Decrement the reference count so the GC will catch it */
Tcl_DecrRefCount(command);
Tcl_DecrRefCount(nick);
Tcl_DecrRefCount(uhost);
Tcl_DecrRefCount(hand);
Tcl_DecrRefCount(chan);
Tcl_DecrRefCount(msg);
/* If we returned an error, send it to trollbot's warning channel */
if (ret == TCL_ERROR)
{
troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
}
free(objv);
break;
}
}
int
Tcl_RecordAndEvalObj(
Tcl_Interp *interp, /* Token for interpreter in which command will
* be executed. */
Tcl_Obj *cmdPtr, /* Points to object holding the command to
* record and execute. */
int flags) /* Additional flags. TCL_NO_EVAL means record
* only: don't execute the command.
* TCL_EVAL_GLOBAL means evaluate the script
* in global variable context instead of the
* current procedure. */
{
int result, call = 1;
Tcl_CmdInfo info;
HistoryObjs *histObjsPtr =
Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);
/*
* Create the references to the [::history add] command if necessary.
*/
if (histObjsPtr == NULL) {
histObjsPtr = Tcl_Alloc(sizeof(HistoryObjs));
TclNewLiteralStringObj(histObjsPtr->historyObj, "::history");
TclNewLiteralStringObj(histObjsPtr->addObj, "add");
Tcl_IncrRefCount(histObjsPtr->historyObj);
Tcl_IncrRefCount(histObjsPtr->addObj);
Tcl_SetAssocData(interp, HISTORY_OBJS_KEY, DeleteHistoryObjs,
histObjsPtr);
}
/*
* Do not call [history] if it has been replaced by an empty proc
*/
result = Tcl_GetCommandInfo(interp, "::history", &info);
if (result && (info.deleteProc == TclProcDeleteProc)) {
Proc *procPtr = (Proc *) info.objClientData;
call = (procPtr->cmdPtr->compileProc != TclCompileNoOp);
}
if (call) {
Tcl_Obj *list[3];
/*
* Do recording by eval'ing a tcl history command: history add $cmd.
*/
list[0] = histObjsPtr->historyObj;
list[1] = histObjsPtr->addObj;
list[2] = cmdPtr;
Tcl_IncrRefCount(cmdPtr);
(void) Tcl_EvalObjv(interp, 3, list, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(cmdPtr);
/*
* One possible failure mode above: exceeding a resource limit.
*/
if (Tcl_LimitExceeded(interp)) {
return TCL_ERROR;
}
}
/*
* Execute the command.
*/
result = TCL_OK;
if (!(flags & TCL_NO_EVAL)) {
result = Tcl_EvalObjEx(interp, cmdPtr, flags & TCL_EVAL_GLOBAL);
}
return result;
}
Tk_Image
HtmlImageImage(HtmlImage2 *pImage)
{
assert(pImage && (pImage->isValid == 1 || pImage->isValid == 0));
if (!pImage->isValid) {
/* pImage->image is invalid. This happens if the underlying Tk
* image, or the image that this is a scaled copy of, is changed
* or deleted. It also happens the first time this function is
* called after a call to HtmlImageScale().
*/
Tk_PhotoHandle photo;
Tk_PhotoImageBlock block;
Tcl_Interp *interp = pImage->pImageServer->pTree->interp;
HtmlImage2 *pUnscaled = pImage->pUnscaled;
if (pUnscaled->pixmap) {
Tcl_Obj *apObj[4];
int rc;
/*printf("TODO: BAD. Have to recreate image to make scaled copy.\n");*/
apObj[0] = pUnscaled->pImageName;
apObj[1] = Tcl_NewStringObj("configure", -1);
apObj[2] = Tcl_NewStringObj("-data", -1);
apObj[3] = pUnscaled->pCompressed;
Tcl_IncrRefCount(apObj[1]);
Tcl_IncrRefCount(apObj[2]);
Tcl_IncrRefCount(apObj[3]);
pUnscaled->nIgnoreChange++;
rc = Tcl_EvalObjv(interp, 4, apObj, TCL_EVAL_GLOBAL);
pUnscaled->nIgnoreChange--;
assert(rc==TCL_OK);
Tcl_IncrRefCount(apObj[3]);
Tcl_DecrRefCount(apObj[2]);
Tcl_DecrRefCount(apObj[1]);
}
assert(pUnscaled);
if (!pImage->pImageName) {
/* If pImageName is still NULL, then create a new photo
* image to write the scaled data to. Todo: Is it possible
* to do this without invoking a script, creating the Tcl
* command etc.?
*/
Tk_Window win = pImage->pImageServer->pTree->tkwin;
Tcl_Interp *interp = pImage->pImageServer->pTree->interp;
const char *z;
Tcl_Eval(interp, "image create photo");
pImage->pImageName = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(pImage->pImageName);
assert(0 == pImage->pDelete);
assert(0 == pImage->image);
z = Tcl_GetString(pImage->pImageName);
pImage->image = Tk_GetImage(interp, win, z, imageChanged, pImage);
}
assert(pImage->image);
CHECK_INTEGER_PLAUSIBILITY(pImage->width);
CHECK_INTEGER_PLAUSIBILITY(pImage->height);
CHECK_INTEGER_PLAUSIBILITY(pUnscaled->width);
CHECK_INTEGER_PLAUSIBILITY(pUnscaled->height);
/* Write the scaled data into image pImage->image */
photo = Tk_FindPhoto(interp, Tcl_GetString(pUnscaled->pImageName));
if (photo) {
Tk_PhotoGetImage(photo, &block);
}
if (photo && block.pixelPtr) {
int x, y; /* Iterator variables */
int w, h; /* Width and height of unscaled image */
int sw, sh; /* Width and height of scaled image */
Tk_PhotoHandle s_photo;
Tk_PhotoImageBlock s_block;
sw = pImage->width;
sh = pImage->height;
w = pUnscaled->width;
h = pUnscaled->height;
s_photo = Tk_FindPhoto(interp, Tcl_GetString(pImage->pImageName));
s_block.pixelPtr = (unsigned char *)HtmlAlloc("temp", sw * sh * 4);
s_block.width = sw;
s_block.height = sh;
s_block.pitch = sw * 4;
s_block.pixelSize = 4;
s_block.offset[0] = 0;
s_block.offset[1] = 1;
s_block.offset[2] = 2;
s_block.offset[3] = 3;
for (x=0; x<sw; x++) {
int orig_x = ((x * w) / sw);
for (y=0; y<sh; y++) {
unsigned char *zOrig;
unsigned char *zScale;
int orig_y = ((y * h) / sh);
zOrig = &block.pixelPtr[
orig_x * block.pixelSize + orig_y * block.pitch];
zScale = &s_block.pixelPtr[
x * s_block.pixelSize + y * s_block.pitch];
zScale[0] = zOrig[block.offset[0]];
zScale[1] = zOrig[block.offset[1]];
zScale[2] = zOrig[block.offset[2]];
zScale[3] = zOrig[block.offset[3]];
}
}
photoputblock(interp, s_photo, &s_block, 0, 0, sw, sh, 0);
HtmlFree(s_block.pixelPtr);
} else {
return HtmlImageImage(pImage->pUnscaled);
}
pImage->isValid = 1;
if (pUnscaled->pixmap) {
Tcl_Obj *apObj[4];
apObj[0] = Tcl_NewStringObj("image", -1);
apObj[1] = Tcl_NewStringObj("create", -1);
apObj[2] = Tcl_NewStringObj("photo", -1);
apObj[3] = pUnscaled->pImageName;
Tcl_IncrRefCount(apObj[0]);
Tcl_IncrRefCount(apObj[1]);
Tcl_IncrRefCount(apObj[2]);
pUnscaled->nIgnoreChange++;
Tcl_EvalObjv(interp, 4, apObj, TCL_EVAL_GLOBAL);
pUnscaled->nIgnoreChange--;
Tcl_DecrRefCount(apObj[2]);
Tcl_DecrRefCount(apObj[1]);
Tcl_IncrRefCount(apObj[0]);
}
}
return pImage->image;
}
void CallBinds(binding_type_e type, const char* user, CClientConnection *client, int argc, const char** argv) {
Tcl_Obj** listv;
CUser *User = NULL;
int idx = 1;
Tcl_Obj* objv[3];
bool lazyConversionDone = false;
for (int i = 0; i < g_BindCount; i++) {
if (g_Binds[i].valid && g_Binds[i].type == type) {
Tcl_DString dsProc;
if (user && strcasecmp(g_Binds[i].user, user) != 0 && !strcasecmp(g_Binds[i].user, "*") == 0)
continue;
bool Match = false;
if (g_Binds[i].pattern == NULL || strcmp(g_Binds[i].pattern, "*") == 0)
Match = true;
if (!Match) {
for (int a = 0; a < argc; a++) {
if (strcasecmp(g_Binds[i].pattern, argv[a]) == 0) {
//if (g_Bouncer->Match(g_Binds[i].pattern, argv[a])) {
Match = true;
break;
}
}
}
if (Match) {
if (!lazyConversionDone) {
if (user) {
Tcl_DString dsUser;
Tcl_ExternalToUtfDString(g_Encoding, user ? user : "", -1, &dsUser);
objv[idx++] = Tcl_NewStringObj(Tcl_DStringValue(&dsUser), Tcl_DStringLength(&dsUser));
Tcl_DStringFree(&dsUser);
Tcl_IncrRefCount(objv[idx - 1]);
}
if (argc) {
listv = (Tcl_Obj**)malloc(sizeof(Tcl_Obj*) * argc);
for (int a = 0; a < argc; a++) {
Tcl_DString dsString;
Tcl_ExternalToUtfDString(g_Encoding, argv[a], -1, &dsString);
listv[a] = Tcl_NewStringObj(Tcl_DStringValue(&dsString), Tcl_DStringLength(&dsString));
Tcl_DStringFree(&dsString);
Tcl_IncrRefCount(listv[a]);
}
objv[idx++] = Tcl_NewListObj(argc, listv);
Tcl_IncrRefCount(objv[idx - 1]);
for (int a = 0; a < argc; a++) {
Tcl_DecrRefCount(listv[a]);
}
free(listv);
}
lazyConversionDone = true;
}
Tcl_ExternalToUtfDString(g_Encoding, g_Binds[i].proc, -1, &dsProc);
objv[0] = Tcl_NewStringObj(Tcl_DStringValue(&dsProc), Tcl_DStringLength(&dsProc));
Tcl_DStringFree(&dsProc);
Tcl_IncrRefCount(objv[0]);
if (User == NULL) {
User = g_Bouncer->GetUser(user);
}
if (User != NULL) {
setctx(user);
}
g_CurrentClient = client;
Tcl_EvalObjv(g_Interp, idx, objv, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(objv[0]);
}
}
}
if (lazyConversionDone) {
for (int i = 1; i < idx; i++) {
if (objv[i])
Tcl_DecrRefCount(objv[i]);
}
}
}
