// (print expr)
static Obj *prim_print(void *root, Obj **env, Obj **list) {
DEFINE1(tmp);
*tmp = (*list)->car;
print(eval(root, env, tmp));
printf("\n");
return Nil;
}
// (macroexpand expr)
static Obj *prim_macroexpand(void *root, Obj **env, Obj **list) {
if (length(*list) != 1)
error("Malformed macroexpand");
DEFINE1(body);
*body = (*list)->car;
return macroexpand(root, env, body);
}
// (begin expr ...)
static Obj *prim_begin(void *root, Obj **env, Obj **list) {
if (length(*list) < 1)
error("Malformed begin");
DEFINE1(exprs);
*exprs = (*list); //->car;
eval_list(root, env, exprs);
return Nil;
}
// (setcar <cell> expr)
static Obj *prim_setcar(void *root, Obj **env, Obj **list) {
DEFINE1(args);
*args = eval_list(root, env, list);
if (length(*args) != 2 || (*args)->car->type != TCELL)
error("Malformed setcar");
(*args)->car->car = (*args)->cdr->car;
return (*args)->car;
}
// May create a new symbol. If there's a symbol with the same name, it will not create a new symbol
// but return the existing one.
static Obj *intern(void *root, char *name) {
for (Obj *p = Symbols; p != Nil; p = p->cdr)
if (strcmp(name, p->car->name) == 0)
return p->car;
DEFINE1(sym);
*sym = make_symbol(root, name);
Symbols = cons(root, sym, &Symbols);
return *sym;
}
// Apply fn with args.
static Obj *apply(void *root, Obj **env, Obj **fn, Obj **args) {
if (!is_list(*args))
error("argument must be a list");
if ((*fn)->type == TPRIMITIVE)
return (*fn)->fn(root, env, args);
if ((*fn)->type == TFUNCTION) {
DEFINE1(eargs);
*eargs = eval_list(root, env, args);
return apply_func(root, env, fn, eargs);
}
error("not supported");
}
Obj* c_audio_getPitch(void* root, Obj** env, Obj** list)
{
if (length(*list) != 1)
error("Expected <custom>.");
Obj* arg = eval(root, env, &(*list)->car);
DEFINE1(ret);
if (moduleData.audio_type == audio_type_static)
{
audio_StaticSource* source = (audio_StaticSource*)arg->custom;
float pitch = audio_StaticSource_getPitch(source);
*ret = make_int(root, pitch);
return *ret;
}
audio_StreamSource* source = (audio_StreamSource*)arg->custom;
float pitch = audio_StreamSource_getPitch(source);
*ret = make_int(root, pitch);
return *ret;
}
Obj* c_audio_newSource(void* root, Obj** env, Obj** list)
{
if (length(*list) < 1 || length(*list) > 2)
error("audio newSource expects 1 or 2 args");
char* filename = creo_tostring(root, env, list, 0);
char* type = creo_optstring(root, env, list, 1, "static");
int err;
DEFINE1(ret);
if (strcmp(type, "stream") == 0)
{
audio_StreamSource* src = malloc(sizeof(audio_StreamSource));
err = audio_loadStream(src, filename);
moduleData.audio_type = audio_type_stream;
*ret = make_custom(root, src);
}
else if (strcmp(type, "static") == 0)
{
audio_StaticSource* src = malloc(sizeof(audio_StaticSource));
err = audio_loadStatic(src, filename);
moduleData.audio_type = audio_type_static;
*ret = make_custom(root, src);
}
if (err == -1)
error("Could not load file: %s%s", filename,
" reason: unknown file type");
if (err == 0)
error("Could not load file: %s%s", filename,
" reason: file does not exist");
return *ret;
}
Obj* c_audio_getType(void* root, Obj** env, Obj** list)
{
if (length(*list) != 1)
error("Expected <custom>.");
Obj* arg = eval(root, env, &(*list)->car);
DEFINE1(ret);
if (moduleData.audio_type == audio_type_static)
{
*ret = make_string(root, "static");
return *ret;
}
else if (moduleData.audio_type == audio_type_stream)
{
*ret = make_string(root, "stream");
return *ret;
}
else
return Nil;
return True;
}
static void define_constants(void *root, Obj **env) {
DEFINE1(sym);
*sym = intern(root, "t");
add_variable(root, env, sym, &True);
}
// Returns ((x . y) . a)
static Obj *acons(void *root, Obj **x, Obj **y, Obj **a) {
DEFINE1(cell);
*cell = cons(root, x, y);
return cons(root, cell, a);
}