Scheme_Object* scheme_initialize( Scheme_Env * env )
{
DWORD threadID;
Scheme_Env * menv;
Scheme_Small_Object * hotkey_event;
g_native_semaphore = CreateSemaphore( NULL, 0, 500, SEMA_NAME );
CreateThread( NULL, 0, ThreadProc, NULL, 0, &threadID );
menv = scheme_primitive_module( scheme_module_name(), env );
g_hotkey_event_type = scheme_make_type("<system-event>");
hotkey_event = (Scheme_Small_Object*) scheme_malloc( sizeof(Scheme_Small_Object) );
hotkey_event->iso.so.type = g_hotkey_event_type;
hotkey_event->u.int_val = (long)g_native_semaphore;
scheme_register_extension_global( hotkey_event, sizeof(Scheme_Small_Object) );
scheme_add_evt( g_hotkey_event_type,
(Scheme_Ready_Fun) scheme_hotkey_inactive,
(Scheme_Needs_Wakeup_Fun) scheme_hotkey_needs_wakeup,
NULL, 0);
scheme_add_global( "system-events-event", (Scheme_Object*) hotkey_event, menv );
scheme_add_global( "last-system-event",
scheme_make_prim_w_arity( scm_last_system_event, "last-system-event", 0, 0 ),
menv );
scheme_finish_primitive_module( menv );
return scheme_void;
}
Scheme_Object *scheme_reload(Scheme_Env *env)
{
Scheme_Object *proc;
Scheme_Env *mod_env;
mod_env = scheme_primitive_module(scheme_intern_symbol("midi_extension"),env);
// make sure we start with a clean slate
midi_io.finalise();
proc=scheme_make_prim_w_arity(list_devices,"list-midi-devices",0,0);
scheme_add_global("list-midi-devices",proc,mod_env);
proc=scheme_make_prim_w_arity(set_input_device,"set-midi-input",1,1);
scheme_add_global("set-midi-input",proc,mod_env);
proc=scheme_make_prim_w_arity(set_output_device,"set-midi-output",1,1);
scheme_add_global("set-midi-output",proc,mod_env);
proc=scheme_make_prim_w_arity(startmidi,"start-midi-io",0,0);
scheme_add_global("start-midi-io",proc,mod_env);
proc=scheme_make_prim_w_arity(stopmidi,"stop-midi-io",0,0);
scheme_add_global("stop-midi-io",proc,mod_env);
proc=scheme_make_prim_w_arity(note_on,"note-on",3,3);
scheme_add_global("note-on",proc,mod_env);
proc=scheme_make_prim_w_arity(note_off,"note-off",3,3);
scheme_add_global("note-off",proc,mod_env);
proc=scheme_make_prim_w_arity(read_event,"read-midi-event",0,0);
scheme_add_global("read-midi-event",proc,mod_env);
scheme_finish_primitive_module(mod_env);
return scheme_void;
} // scheme_reload()
Scheme_Object* scheme_initialize(Scheme_Env *env)
{
Scheme_Env* menv;
menv = scheme_primitive_module(scheme_intern_symbol("ext"), env);
scheme_add_global("EAGAIN", scheme_make_integer(EAGAIN), menv);
scheme_add_global("zmq_poll*",
scheme_make_prim_w_arity(zpoll, "zmq_poll*", 3, 3), menv);
scheme_finish_primitive_module(menv);
return scheme_void;
}
Scheme_Object *scheme_reload (Scheme_Env *env)
{
Scheme_Env *menv;
Scheme_Object *proc1;
Scheme_Object *proc2;
Scheme_Object *proc3;
// Converting a C procedure to a scheme procedure.
proc1 = scheme_make_prim_w_arity (pardbus_get_object, "rdbus-get-object", 3, -1);
proc2 = scheme_make_prim_w_arity (pardbus_call_method, "rdbus-call-method", 3,-1);
proc3 = scheme_make_prim_w_arity (pardbus_init, "rdbus_init", 0,0);
// Add the new procedures to the shared object for Racket to use
scheme_add_global ("rdbus-get-object", proc1, env);
scheme_add_global ("rdbus-call-method", proc2, env);
scheme_add_global ("rdbus_init", proc3, env);
return scheme_void;
} // scheme_reload
/**
* Register a scheme function. Provides a slightly more concise interface
* to a few lines that we type regularly.
*/
static void
register_function (Scheme_Prim *prim, gchar *name,
int minarity, int maxarity,
Scheme_Env *menv)
{
Scheme_Object *proc =
scheme_make_prim_w_arity (prim, name, minarity, maxarity);
scheme_add_global (name, proc, menv);
} // register_function
Scheme_Object *scheme_reload(Scheme_Env *env)
{
scheme_add_global("eval-string/catch-error",
scheme_make_prim_w_arity(catch_eval_error,
"eval-string/catch-error",
1, 1),
env);
return scheme_void;
}
Scheme_Object *scheme_reload(Scheme_Env *env)
{
scheme_add_global("long-long-size",
scheme_make_prim_w_arity(llsize, "long-long-size", 0, 0),
env);
scheme_add_global("integer->long-long-bytes",
scheme_make_prim_w_arity(toll, "integer->long-long-bytes", 1, 1),
env);
scheme_add_global("integer->unsigned-long-long-bytes",
scheme_make_prim_w_arity(toull, "integer->unsigned-long-long-bytes", 1, 1),
env);
scheme_add_global("long-long-bytes->integer",
scheme_make_prim_w_arity(fromll, "long-long-bytes->integer", 1, 1),
env);
scheme_add_global("unsigned-long-long-bytes->integer",
scheme_make_prim_w_arity(fromull, "unsigned-long-long-bytes->integer", 1, 1),
env);
return scheme_void;
}
Scheme_Object *scheme_reload(Scheme_Env *env)
{
Scheme_Env *menv;
menv = scheme_primitive_module(scheme_intern_symbol("embed-me8"),
env);
scheme_add_global("ex", scheme_make_prim_w_arity(ex, "ex", 0, 0), menv);
scheme_finish_primitive_module(menv);
return scheme_void;
}
Scheme_Object *
scheme_reload (Scheme_Env *env)
{
Scheme_Env *menv = NULL; // The module's environment
Scheme_Object *proc = NULL; // A Procedure we're adding
// Annotations for the garbage collector
MZ_GC_DECL_REG (2);
MZ_GC_VAR_IN_REG (0, env);
MZ_GC_VAR_IN_REG (1, menv);
MZ_GC_REG ();
// Build the module environment.
menv = scheme_primitive_module (scheme_intern_symbol ("loudbus"),
env);
// Build the procedures
proc = scheme_make_prim_w_arity (loudbus_call, "loudbus-call", 2, -1);
scheme_add_global ("loudbus-call", proc, menv);
proc = scheme_make_prim_w_arity (loudbus_import, "loudbus-import", 3, 3),
scheme_add_global ("loudbus-import", proc, menv);
proc = scheme_make_prim_w_arity (loudbus_init, "loudbus-init", 1, 1),
scheme_add_global ("loudbus-init", proc, menv);
proc = scheme_make_prim_w_arity (loudbus_methods, "loudbus-methods", 1, 1),
scheme_add_global ("loudbus-methods", proc, menv);
proc = scheme_make_prim_w_arity (loudbus_proxy, "loudbus-proxy", 3, 3),
scheme_add_global ("loudbus-proxy", proc, menv);
// And we're done.
scheme_finish_primitive_module (menv);
MZ_GC_UNREG ();
return scheme_void;
} // scheme_reload
/**
* Add one of the procedures that the proxy provides on the D-Bus.
*/
static void
loudbus_add_dbus_proc (Scheme_Env *env,
Scheme_Object *proxy,
gchar *dbus_name,
gchar *external_name,
int arity)
{
Scheme_Object *vals[3];
Scheme_Object *proc;
vals[0] = NULL;
vals[1] = NULL;
vals[2] = NULL;
// Prepare for potential garbage collection during allocating calls
// (e.g., scheme_make_locale_string).
MZ_GC_DECL_REG (3);
MZ_GC_VAR_IN_REG (0, vals[0]);
MZ_GC_VAR_IN_REG (1, vals[1]);
MZ_GC_VAR_IN_REG (2, vals[2]);
MZ_GC_REG ();
// Fill in the closure with the object.
vals[0] = proxy;
vals[1] = scheme_make_locale_string (dbus_name);
vals[2] = scheme_make_locale_string (external_name);
// Build the procedure. Note that we need to duplicate the
// external name because scheme_make_prim_closure_w_arity seems
// to retain a pointer to the string. (At least, it seems that way
// to me.)
proc = scheme_make_prim_closure_w_arity (loudbus_call_with_closure,
3, vals,
g_strdup (external_name),
arity, arity);
// And add it to the environment.
scheme_add_global (external_name, proc, env);
// And update the GC info.
MZ_GC_UNREG ();
} // loudbus_add_dbus_proc
Scheme_Object *scheme_reload(Scheme_Env *env)
{
Scheme_Object *proc;
/* The MZ_GC... lines are for for 3m, because env is live across an
allocating call. They're not needed for plain old (conservatively
collected) Mzscheme. See makeadder3m.c for more info. */
MZ_GC_DECL_REG(1);
MZ_GC_VAR_IN_REG(0, env);
MZ_GC_REG();
/* Package the C implementation of fmod into a Scheme procedure
value: */
proc = scheme_make_prim_w_arity(sch_fmod, "fmod", 2, 2);
/* Requires at least two args ------^ ^ */
/* Accepts no more than two args ---| */
/* Define `fmod' as a global :*/
scheme_add_global("fmod", proc, env);
MZ_GC_UNREG();
return scheme_void;
}
Scheme_Object *
scheme_reload (Scheme_Env *env)
{
Scheme_Env *menv = NULL; // The module's environment.
Scheme_Object *proc = NULL; // A procedure that we're adding.
// Annotations for the garbage collector
MZ_GC_DECL_REG (2);
MZ_GC_VAR_IN_REG (0, env);
MZ_GC_VAR_IN_REG (1, menv);
MZ_GC_REG ();
// Build the module environment
menv = scheme_primitive_module (scheme_intern_symbol ("irgb"), env);
// Add the procedures
proc = scheme_make_prim_w_arity (irgb_alpha, "irgb-alpha", 1, 1);
scheme_add_global ("irgb-alpha", proc, menv);
proc = scheme_make_prim_w_arity (irgb_blue, "irgb-blue", 1, 1);
scheme_add_global ("irgb-blue", proc, menv);
proc = scheme_make_prim_w_arity (irgb_green, "irgb-green", 1, 1);
scheme_add_global ("irgb-green", proc, menv);
proc = scheme_make_prim_w_arity (irgb_new, "irgb-new", 3, 3);
scheme_add_global ("irgb-new", proc, menv);
proc = scheme_make_prim_w_arity (irgb_red, "irgb-red", 1, 1);
scheme_add_global ("irgb-red", proc, menv);
proc = scheme_make_prim_w_arity (irgba_new, "irgba-new", 4, 4);
scheme_add_global ("irgba-new", proc, menv);
// Clean up
scheme_finish_primitive_module (menv);
MZ_GC_UNREG ();
// And we're done
return scheme_void;
} // scheme_reload
Scheme_Object *scheme_reload(Scheme_Env *env)
{
scheme_add_global("date", scheme_make_prim(sch_date), env);
return scheme_void;
}
Scheme_Object *scheme_reload(Scheme_Env *env)
{
Scheme_Env *mod_env;
mod_env = scheme_primitive_module(scheme_intern_symbol("make-gl-info-helper"), env);
scheme_add_global("gl-byte-size",
scheme_make_integer_value(sizeof(GLbyte)),
mod_env);
scheme_add_global("gl-ubyte-size",
scheme_make_integer_value(sizeof(GLubyte)),
mod_env);
scheme_add_global("gl-short-size",
scheme_make_integer_value(sizeof(GLshort)),
mod_env);
scheme_add_global("gl-ushort-size",
scheme_make_integer_value(sizeof(GLushort)),
mod_env);
scheme_add_global("gl-int-size",
scheme_make_integer_value(sizeof(GLint)),
mod_env);
scheme_add_global("gl-uint-size",
scheme_make_integer_value(sizeof(GLuint)),
mod_env);
scheme_add_global("gl-float-size",
scheme_make_integer_value(sizeof(GLfloat)),
mod_env);
scheme_add_global("gl-double-size",
scheme_make_integer_value(sizeof(GLdouble)),
mod_env);
scheme_add_global("gl-boolean-size",
scheme_make_integer_value(sizeof(GLboolean)),
mod_env);
scheme_add_global("gl-sizei-size",
scheme_make_integer_value(sizeof(GLsizei)),
mod_env);
scheme_add_global("gl-clampf-size",
scheme_make_integer_value(sizeof(GLclampf)),
mod_env);
scheme_add_global("gl-clampd-size",
scheme_make_integer_value(sizeof(GLclampd)),
mod_env);
scheme_add_global("gl-enum-size",
scheme_make_integer_value(sizeof(GLenum)),
mod_env);
scheme_add_global("gl-bitfield-size",
scheme_make_integer_value(sizeof(GLbitfield)),
mod_env);
scheme_finish_primitive_module(mod_env);
return scheme_void;
}
