bool XSalNode::applyNode(SchemeThread* st, double curtime)
{
s7_scheme* sc=st->scheme;
s7_pointer data=st->schemeNil;
Console* console=Console::getInstance();
// cons up token list using reverse order of array
for (int i=toks.size()-1; i>=0; i--)
{
data=s7_cons(sc, s7_make_c_pointer(sc, toks.getUnchecked(i)), data);
}
// turn data into arglist ("input" ({tok}*) [#t|#f]*)
data=s7_cons(sc,
s7_make_string(sc, expr.toUTF8()),
s7_cons(sc,
data,
s7_cons(sc,
s7_make_boolean(sc, expand),
s7_cons(sc,
s7_make_boolean(sc, multi),
st->schemeNil)))
);
// gc protect data cobbled up on the C side
int prot = s7_gc_protect(sc, data);
s7_pointer retn;
st->isSalEval(true);
//// console->postAsyncMessage(CommandIDs::ConsoleIsEvaling, 1, true);
st->setSchemeInterrupt(false);
s7_set_begin_hook(sc, cm_begin_hook);
if (vers==TextIDs::Sal1)
{
// sal only side effects so we never process return values
retn=s7_call(sc, s7_name_to_value(sc, "sal"), data);
}
else
{
retn=s7_call(sc, s7_name_to_value(sc, "sal2"), data);
if (retn != st->schemeError)
{
//cm_print(retn);
String str=String(s7_object_to_c_string(sc, retn));
str << T("\n");
for (int i=0; i<str.length(); i++)
if (str[i]==T('(')) str[i]=T('{');
else if (str[i]==T(')')) str[i]=T('}');
console->printValues(str);
}
}
s7_gc_unprotect_at(sc, prot);
s7_set_begin_hook(sc, NULL);
if (st->isSchemeInterrupt())
{
console->printWarning(T("Scheme interrupted!\n"));
}
st->isSalEval(false);
/// console->postAsyncMessage(CommandIDs::ConsoleIsEvaling, 0, true);
return false;
}
void SchemeThread::addOscHook(String path, s7_pointer proc)
{
//oscHooks.lockArray();
s7_gc_protect(scheme, proc);
// the "default hook" is always at end
if (path==String::empty)
oscHooks.add(new OscHook(path,proc));
else
oscHooks.insert(0, new OscHook(path,proc));
// oscHooks.unlockArray();
}
void SchemeThread::addMidiHook(int op, s7_pointer proc)
{
//midiHooks.lockArray();
s7_gc_protect(scheme, proc);
// the "default hook" is always at end
if (op==0)
midiHooks.add(new MidiHook(op,proc));
else
midiHooks.insert(0, new MidiHook(op,proc));
//midiHooks.unlockArray();
}
static Xen g_mus_set_sound_path(Xen val)
{
Xen_check_type(Xen_is_list(val), val, 1, S_set S_mus_sound_path, "a list");
#if HAVE_SCHEME
if (sound_path_loc != -1)
s7_gc_unprotect_at(s7, sound_path_loc);
sound_path = val;
sound_path_loc = s7_gc_protect(s7, sound_path);
s7_symbol_set_value(s7, mus_sound_path_symbol, val);
#else
if (sound_path != Xen_empty_list)
Xen_GC_unprotect(sound_path);
Xen_GC_protect(val);
sound_path = val;
#endif
return(val);
}
void SchemeThread::sprout(double _time, s7_pointer proc, int _id)
{
// this method is only called by scheme code via sprout() under an
// eval node. this means that a lock.enter() is in effect so we
// dont need to lock anything to reference scoremode.
if (!isScoreMode())
_time = (_time * 1000) + Time::getMillisecondCounterHiRes();
else
_time += scoretime; // shift process to current scoretime under callback
s7_gc_protect(scheme, proc); // don't let gc touch it
sprouted=true; // tell scheduler that we have a process running
// schemeNodes.lockArray();
schemeNodes.addSorted(comparator, new XProcessNode( _time, proc, _id));
// schemeNodes.unlockArray();
notify();
}
void ReplWindow::evaluate(Glib::ustring &expression)
{
Scheme *scm = Application::get()->get_scheme();
if (!expression.empty())
{
const char *errmsg;
s7_pointer old_port, result;
int gc_loc = -1;
//
// Open a port to catch error info
//
old_port = s7_set_current_error_port(scm,
s7_open_output_string(scm));
if (old_port != s7_nil(scm))
{
gc_loc = s7_gc_protect(scm, old_port);
}
result = s7_eval_c_string(scm, expression.data());
errmsg = s7_get_output_string(scm, s7_current_error_port(scm));
append_text( "\n" );
if ((errmsg) && (*errmsg))
{
append_text(errmsg);
}
else
{
char *result_as_string;
result_as_string = s7_object_to_c_string(scm, result);
if (result_as_string)
{
append_text(result_as_string);
free(result_as_string);
}
}
s7_close_output_port(scm, s7_current_error_port(scm));
s7_set_current_error_port(scm, old_port);
if (gc_loc != -1)
s7_gc_unprotect_at(scm, gc_loc);
}
}
bool XMidiNode::applyNode(SchemeThread* st, double curtime)
{
s7_scheme* sc=st->scheme;
// called on Midi message nodes if an input hook is set
int op=(mmess.getRawData()[0] & 0xf0)>>4;
int ch=mmess.getChannel()-1;
int d1=mmess.getRawData()[1] & 0x7f;
int d2=0;
if (mmess.getRawDataSize()>2)
d2=mmess.getRawData()[2] & 0x7f;
// convert MidiOns with zero velocity to MidiOff
if ((op==MidiFlags::On) && (d2==0))
op=MidiFlags::Off;
// create list of message data
s7_pointer args=s7_cons(sc,
s7_make_integer(sc, ch),
s7_cons(sc,
s7_make_integer(sc, d1),
s7_cons(sc,
s7_make_integer(sc, d2),
st->schemeNil)));
// ALWAYS PUSH OPCODE // push status opcode if default hook
if (true) // (hook->op==0)
args=s7_cons(sc, s7_make_integer(sc, op), args);
// create funargs list holding data
args=s7_cons(sc, args, st->schemeNil);
int prot = s7_gc_protect(sc, args);
s7_pointer res=s7_call(sc, hook->proc, args);
s7_gc_unprotect_at(sc, prot);
// stubbed out because a void return seems to be the same as schemeError ???????
if (0)// (res == st->schemeError)
{
st->removeMidiHook(hook);
Console::getInstance()->printError(T(">>> Removed Midi receiver.\n"));
}
return false;
}
bool XOscNode::applyNode(SchemeThread* st, double curtime)
{
//std::cout << "Osc message: "<< path.toUTF8() << " " << types.toUTF8();
////st->lockOscHook();
//std::cout << "Osc hook!\n";
s7_scheme* sc=st->scheme;
// the osc message data starts with the string path
s7_pointer snil = st->schemeNil;
s7_pointer data = s7_cons(sc, st->schemeFalse, snil) ; // (#f) placeholder
s7_pointer tail = data;
// iterate types adding floats and ints to message data
int F=0;
int I=0;
int S=0;
for (int i=0; i<types.length(); i++)
{
switch (types[i])
{
case 'i': // LO_INT32
case 'h': // LO_INT64
s7_set_cdr(tail, s7_cons(sc, s7_make_integer(sc, ints[I++]), snil));
break;
case 'f': // LO_FLOAT32
case 'd': // LO_FLOAT64
case 't': // LO_TIMETAG
s7_set_cdr(tail, s7_cons(sc, s7_make_real(sc, flos[F++]), snil));
break;
case 's': // LO_STRING
s7_set_cdr(tail, s7_cons(sc, s7_make_string(sc, strs[S++].toUTF8()), snil));
break;
case 'S': // LO_SYMBOL
s7_set_cdr(tail, s7_cons(sc, s7_make_symbol(sc, strs[S++].toUTF8()), snil));
break;
case 'T': // LO_TRUE
s7_set_cdr(tail, s7_cons(sc, s7_make_boolean(sc, true), snil));
break;
case 'F': // LO_FALSE
s7_set_cdr(tail, s7_cons(sc, s7_make_boolean(sc, false), snil));
break;
case 'N': // LO_NIL
s7_set_cdr(tail, s7_cons(sc, snil, snil));
break;
case 'I': // LO_INFINITUM
s7_set_cdr(tail, s7_cons(sc, s7_name_to_value(sc, "most-positive-fixnum"), snil));
break;
case 'c': // LO_CHAR
s7_set_cdr(tail, s7_cons(sc, s7_make_character(sc, (char)ints[I++]), snil));
break;
case 'm': // LO_MIDI
{
s7_pointer m=s7_cons(sc, s7_make_integer(sc, ints[I+0]),
s7_cons(sc, s7_make_integer(sc, ints[I+1]),
s7_cons(sc, s7_make_integer(sc, ints[I+2]),
s7_cons(sc, s7_make_integer(sc, ints[I+3]), snil))));
s7_set_cdr(tail, s7_cons(sc, s7_cons(sc, m, snil), snil));
I+=4;
}
break;
case 'b': // LO_BLOB
{
int l=(int)ints[I++]; // length of blob
s7_pointer m=snil;
for (int j=I+l-1; i>=I; j--)
m=s7_cons(sc, s7_make_integer(sc, ints[j]), m);
s7_set_cdr(tail, s7_cons(sc, s7_cons(sc, m, snil), snil));
I+=l;
}
break;
default:
break;
}
tail=s7_cdr(tail);
}
// data is now (#f x y ...)
int loc;
s7_pointer args, res;
if (hook->path==String::empty) // is default hook
{
// default hook includes path as first element
// replace placeholder #f with path
s7_set_car(data, s7_make_string(sc, path.toUTF8()));
args=s7_cons(sc, data, snil);
// args now ((x y ...))
loc = s7_gc_protect(sc, args);
res = s7_call(sc, hook->proc, args);
}
else
{
// // no path so reuse placeholder's cons cell:
// s7_set_car(data, s7_cdr(data));
// // data now ((x y ...) x y ...)
// s7_set_cdr(data, snil);
// // data now ((x y ...))
// loc = s7_gc_protect(sc, data);
// res=s7_call(sc, hook->proc, data);
s7_set_car(data, s7_make_string(sc, hook->path.toUTF8()));
args=s7_cons(sc, data, snil);
loc = s7_gc_protect(sc, args);
res = s7_call(sc, hook->proc, args);
}
s7_gc_unprotect_at(sc, loc);
// stubbed out because a void return seems to be the same as schemeError ???????
if (0) // (res == st->schemeError)
{
st->removeOscHook(hook);
Console::getInstance()->printError(T(">>> Removed OSC receiver.\n"));
}
return false;
}
bool XProcessNode::applyNode(SchemeThread* st, double curtime)
{
s7_scheme* sc=st->scheme;
bool more=false;
double runtime, delta;
if (st->isScoreMode())
{
// in score mode the scheduler runs in non-real time and
// node times are in seconds. the node's current time
// becomes the score time under the callback an is used to
// set the timestamps of data sent to ports
runtime=elapsed;
st->scoretime=time;
}
else
{
runtime=(time-start)/1000.0;
}
s7_pointer args = s7_cons(sc,
s7_make_real(sc, runtime),
s7_NIL(sc));
int prot = s7_gc_protect(sc, args);
s7_pointer retn=s7_call(sc, schemeproc, args);
/*delta=s7_number_to_real(s7_call(sc,
schemeproc,
args
)
);*/
if (retn==st->schemeError)
delta=-2;
else
delta=s7_number_to_real(retn);
s7_gc_unprotect_at(sc, prot);
//std::cout << "after callback, delta is " << delta << "\n";
// a delta value less than 0 means that the process is done running,
// where -1 is normal exit, -2 is error exit. in this case gc the
// proc pointer and do not reschedule the node
if (delta<0.0)
{
s7_gc_unprotect(sc,schemeproc);
more=false;
}
else
{
// update the time of the node to the next runttime. the
// values is in milliseconds if scheduler is running in
// real time
more=true;
if (st->isScoreMode())
{
elapsed += delta; // elapsed now user's next run time
time += delta;
}
else
{
elapsed += delta; // elapsed now user's next run time
// calculate delta to next runtime, the difference
// between the last time stamp and the (future) one in
// elapsed
delta = elapsed-runtime;
if (delta<0.0) delta=0.0;
time=Time::getMillisecondCounterHiRes()+(delta*1000.0);
}
}
st->scoretime=0.0;
return more;
}