mirror of
https://github.com/paparazzi/paparazzi.git
synced 2026-06-06 16:58:48 +08:00
Ivy-ocaml binding
This commit is contained in:
Pascal Brisset
@@ -0,0 +1,112 @@
|
||||
# $Id: Makefile,v 1.20 2007/09/04 19:05:43 brisset Exp $
|
||||
|
||||
DESTDIR = /
|
||||
|
||||
DEBUG = n
|
||||
|
||||
|
||||
OCAMLC = ocamlc
|
||||
OCAMLMLI = ocamlc
|
||||
OCAMLOPT = ocamlopt -unsafe
|
||||
OCAMLDEP=ocamldep
|
||||
|
||||
ifeq ($(DEBUG),y)
|
||||
OCAMLFLAGS = -g
|
||||
else
|
||||
OCAMLFLAGS =
|
||||
endif
|
||||
|
||||
OCAMLOPTFLAGS=
|
||||
CFLAGS=-Wall
|
||||
OCAMLINC=-I `ocamlc -where`
|
||||
GLIBINC=`pkg-config --cflags glib-2.0`
|
||||
|
||||
IVY = ivy.ml ivyLoop.ml
|
||||
|
||||
IVYCMO= $(IVY:.ml=.cmo)
|
||||
IVYCMI= $(IVY:.ml=.cmi)
|
||||
IVYMLI= $(IVY:.ml=.mli)
|
||||
IVYCMX= $(IVY:.ml=.cmx)
|
||||
|
||||
GLIBIVY = ivy.ml glibIvy.ml
|
||||
|
||||
GLIBIVYCMO= $(GLIBIVY:.ml=.cmo)
|
||||
GLIBIVYCMI= $(GLIBIVY:.ml=.cmi)
|
||||
GLIBIVYCMX= $(GLIBIVY:.ml=.cmx)
|
||||
|
||||
TKIVY = ivy.ml tkIvy.ml
|
||||
|
||||
TKIVYCMO= $(TKIVY:.ml=.cmo)
|
||||
TKIVYCMI= $(TKIVY:.ml=.cmi)
|
||||
TKIVYCMX= $(TKIVY:.ml=.cmx)
|
||||
|
||||
LIBS = ivy-ocaml.cma ivy-ocaml.cmxa glibivy-ocaml.cma glibivy-ocaml.cmxa
|
||||
# tkivy-ocaml.cma tkivy-ocaml.cmxa
|
||||
|
||||
all : $(LIBS)
|
||||
|
||||
DISTRO=`ocamlc -version`
|
||||
|
||||
deb :
|
||||
cp debian/changelog.$(DISTRO) debian/changelog
|
||||
dpkg-buildpackage -rfakeroot
|
||||
|
||||
ivy : ivy-ocaml.cma ivy-ocaml.cmxa
|
||||
glibivy : glibivy-ocaml.cma glibivy-ocaml.cmxa
|
||||
tkivy : tkivy-ocaml.cma tkivy-ocaml.cmxa
|
||||
|
||||
INST_FILES = $(IVYCMI) $(IVYMLI) glibIvy.cmi $(LIBS) libivy-ocaml.a libglibivy-ocaml.a dllivy-ocaml.so dllglibivy-ocaml.so ivy-ocaml.a glibivy-ocaml.a
|
||||
# tkIvy.cmi libtkivy-ocaml.a dlltkivy-ocaml.so tkivy-ocaml.a
|
||||
|
||||
install : $(LIBS)
|
||||
mkdir -p $(DESTDIR)/`ocamlc -where`
|
||||
cp $(INST_FILES) $(DESTDIR)/`ocamlc -where`
|
||||
|
||||
desinstall :
|
||||
cd `ocamlc -where`; rm -f $(INST_FILES)
|
||||
|
||||
ivy-ocaml.cma : $(IVYCMO) civy.o civyloop.o
|
||||
ocamlmklib -o ivy-ocaml $^ -livy
|
||||
|
||||
ivy-ocaml.cmxa : $(IVYCMX) civy.o civyloop.o
|
||||
ocamlmklib -o ivy-ocaml $^ -livy
|
||||
|
||||
glibivy-ocaml.cma : $(GLIBIVYCMO) civy.o cglibivy.o
|
||||
ocamlmklib -o glibivy-ocaml $^ -lglibivy `pkg-config --libs glib-2.0` -lpcre
|
||||
|
||||
glibivy-ocaml.cmxa : $(GLIBIVYCMX) civy.o cglibivy.o
|
||||
ocamlmklib -o glibivy-ocaml $^ -lglibivy `pkg-config --libs glib-2.0` -lpcre
|
||||
|
||||
tkivy-ocaml.cma : $(TKIVYCMO) civy.o ctkivy.o
|
||||
ocamlmklib -o tkivy-ocaml $^ -livy -ltclivy
|
||||
|
||||
tkivy-ocaml.cmxa : $(TKIVYCMX) civy.o ctkivy.o
|
||||
ocamlmklib -o tkivy-ocaml $^ -livy -ltclivy
|
||||
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .ml .mli .mly .mll .cmi .cmo .cmx .c .o .out .opt
|
||||
|
||||
.ml.cmo :
|
||||
$(OCAMLC) $(OCAMLFLAGS) $(INCLUDES) -c $<
|
||||
.c.o :
|
||||
$(CC) -Wall -c $(OCAMLINC) $(GLIBINC) $<
|
||||
.mli.cmi :
|
||||
$(OCAMLMLI) $(OCAMLFLAGS) -c $<
|
||||
.ml.cmx :
|
||||
$(OCAMLOPT) $(OCAMLOPTFLAGS) -c $<
|
||||
.mly.ml :
|
||||
ocamlyacc $<
|
||||
.mll.ml :
|
||||
ocamllex $<
|
||||
.cmo.out :
|
||||
$(OCAMLC) -custom -o $@ unix.cma -I . ivy-ocaml.cma $< -cclib -livy
|
||||
.cmx.opt :
|
||||
$(OCAMLOPT) -o $@ unix.cmxa -I . ivy-ocaml.cmxa $< -cclib -livy
|
||||
|
||||
clean:
|
||||
\rm -fr *.cm* *.o *.a .depend *~ *.out *.opt .depend *.so *-stamp debian/changelog debian/ivy-ocaml debian/files debian/ivy-ocaml.debhelper.log debian/ivy-ocaml.substvars debian/*~
|
||||
|
||||
.depend:
|
||||
$(OCAMLDEP) $(INCLUDES) *.mli *.ml > .depend
|
||||
|
||||
include .depend
|
||||
@@ -0,0 +1,18 @@
|
||||
OCaml (caml.org) bindings for the Ivy library (www.tls.cena.fr/products/ivy).
|
||||
|
||||
Two libraries are provided:
|
||||
- ivy-ocaml, running with the Ivy main loop (module IvyLoop)
|
||||
- glibivy-ocaml, running with the Glib main loop (provided by lablgtk)
|
||||
|
||||
Installation:
|
||||
- Requires the OCaml compiler and the ivy-c library
|
||||
- "make" to compile
|
||||
- "make install" to set the files (DESTDIR may be specified)
|
||||
- "examples" directory contains the ivyprobe program for both main loops
|
||||
("make ivyivyprobe.out" and "make glibivyprobe.out")
|
||||
|
||||
Documentation:
|
||||
- The Ivy documentation (www.tls.cena.fr/products/ivy)
|
||||
- The .mli files (ivy.mli, ivyLoop.mli and glibIvy.mli)
|
||||
|
||||
Maintainer: Pascal Brisset (pascal dot brisset at enac dot fr)
|
||||
@@ -0,0 +1,37 @@
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
#include <getopt.h>
|
||||
#include <Ivy/timer.h>
|
||||
#include <Ivy/ivychannel.h>
|
||||
#include <Ivy/ivyglibloop.h>
|
||||
#include <glib.h>
|
||||
#include <caml/mlvalues.h>
|
||||
#include <caml/fail.h>
|
||||
#include <caml/callback.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/alloc.h>
|
||||
|
||||
value ivy_GtkmainLoop(value unit)
|
||||
{
|
||||
g_main_loop_run(g_main_loop_new(NULL, FALSE));
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
extern void cb_delete_channel(void *delete_read);
|
||||
extern void cb_read_channel(Channel ch, HANDLE fd, void *closure);
|
||||
|
||||
value ivy_GtkchannelSetUp(value fd, value closure_name)
|
||||
{
|
||||
Channel c;
|
||||
value * closure = caml_named_value(String_val(closure_name));
|
||||
|
||||
c = IvyChannelAdd((HANDLE)Int_val(fd), (void*)closure, cb_delete_channel, cb_read_channel);
|
||||
return Val_int(c);
|
||||
}
|
||||
|
||||
value ivy_GtkchannelClose(value ch)
|
||||
{
|
||||
IvyChannelRemove((Channel)Int_val(ch));
|
||||
return Val_unit;
|
||||
}
|
||||
@@ -0,0 +1,90 @@
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
#include <getopt.h>
|
||||
#include <Ivy/ivy.h>
|
||||
#include <Ivy/ivyloop.h>
|
||||
#include <Ivy/timer.h>
|
||||
#include <caml/mlvalues.h>
|
||||
#include <caml/fail.h>
|
||||
#include <caml/callback.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/alloc.h>
|
||||
|
||||
value ivy_sendMsg(value msg)
|
||||
{
|
||||
IvySendMsg(String_val(msg));
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
value ivy_stop(value unit)
|
||||
{
|
||||
IvyStop ();
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
|
||||
void app_cb(IvyClientPtr app, void *user_data, IvyApplicationEvent event )
|
||||
{
|
||||
value closure = *(value*)user_data;
|
||||
callback2(closure, Val_int(app), Val_int(event));
|
||||
}
|
||||
|
||||
value ivy_init(value vappName, value vready, value closure_name)
|
||||
{
|
||||
value * closure = caml_named_value(String_val(closure_name));
|
||||
char * appName = malloc(strlen(String_val(vappName))+1); /* Memory leak */
|
||||
strcpy(appName, String_val(vappName));
|
||||
char * ready = malloc(strlen(String_val(vready))+1); /* Memory leak */
|
||||
strcpy(ready, String_val(vready));
|
||||
IvyInit(appName, ready, app_cb, (void*)closure, 0, 0); /* When the "die callback" is called ??? */
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
value ivy_start(value bus)
|
||||
{
|
||||
IvyStart(String_val(bus));
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
void ClosureCallback(IvyClientPtr app, void *closure, int argc, char **argv)
|
||||
{
|
||||
char* t[argc+1];
|
||||
int i;
|
||||
/* Copie de argv dans t avec ajout d'un pointeur nul a la fin */
|
||||
for(i=0; i < argc; i++) t[i] = argv[i];
|
||||
t[argc] = (char*)0L;
|
||||
callback2(*(value*)closure, Val_int((int)app), copy_string_array((char const **)t));
|
||||
}
|
||||
|
||||
value ivy_bindMsg(value cb_name, value regexp)
|
||||
{
|
||||
value * closure = caml_named_value(String_val(cb_name));
|
||||
MsgRcvPtr id = IvyBindMsg(ClosureCallback, (void*)closure, String_val(regexp));
|
||||
return Val_int((int)id);
|
||||
}
|
||||
|
||||
value ivy_unbindMsg(value id)
|
||||
{
|
||||
IvyUnbindMsg((MsgRcvPtr)Int_val(id));
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
value ivy_name_of_client(value c)
|
||||
{
|
||||
return copy_string(IvyGetApplicationName((IvyClientPtr)Int_val(c)));
|
||||
}
|
||||
value ivy_host_of_client(value c)
|
||||
{
|
||||
return copy_string(IvyGetApplicationHost((IvyClientPtr)Int_val(c)));
|
||||
}
|
||||
|
||||
void cb_delete_channel(void *delete_read)
|
||||
{
|
||||
}
|
||||
|
||||
|
||||
void cb_read_channel(Channel ch, HANDLE fd, void *closure)
|
||||
{
|
||||
callback(*(value*)closure, Val_int(ch));
|
||||
}
|
||||
@@ -0,0 +1,60 @@
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
#include <getopt.h>
|
||||
#include <Ivy/ivy.h>
|
||||
#include <Ivy/ivyloop.h>
|
||||
#include <Ivy/timer.h>
|
||||
#include <caml/mlvalues.h>
|
||||
#include <caml/fail.h>
|
||||
#include <caml/callback.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/alloc.h>
|
||||
|
||||
value ivy_mainLoop(value unit)
|
||||
{
|
||||
IvyMainLoop (NULL, NULL);
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
void timer_cb(TimerId id, void *data, unsigned long delta)
|
||||
{
|
||||
value closure = *(value*)data;
|
||||
callback(closure, Val_int((int) id));
|
||||
}
|
||||
|
||||
value ivy_timerRepeatafter(value nb_ticks,value delay, value closure_name)
|
||||
{
|
||||
value * closure = caml_named_value(String_val(closure_name));
|
||||
TimerId id = TimerRepeatAfter(Int_val(nb_ticks), Int_val(delay), timer_cb, (void*)closure);
|
||||
return Val_int(id);
|
||||
}
|
||||
|
||||
/* Data associated to Channel callbacks is the couple of delete and
|
||||
read closures */
|
||||
|
||||
void cb_delete_channel(void *delete_read);
|
||||
void cb_read_channel(Channel ch, HANDLE fd, void *closure);
|
||||
|
||||
|
||||
value ivy_channelSetUp(value fd, value closure_name)
|
||||
{
|
||||
Channel c;
|
||||
value * closure = caml_named_value(String_val(closure_name));
|
||||
|
||||
c = IvyChannelAdd((HANDLE)Int_val(fd), (void*)closure, cb_delete_channel, cb_read_channel);
|
||||
return Val_int(c);
|
||||
}
|
||||
|
||||
value ivy_timerRemove(value t)
|
||||
{
|
||||
TimerRemove((TimerId)Int_val(t));
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
|
||||
value ivy_channelClose(value ch)
|
||||
{
|
||||
IvyChannelRemove((Channel)Int_val(ch));
|
||||
return Val_unit;
|
||||
}
|
||||
@@ -0,0 +1,36 @@
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
#include <getopt.h>
|
||||
#include <timer.h>
|
||||
#include <caml/mlvalues.h>
|
||||
#include <caml/fail.h>
|
||||
#include <caml/callback.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/alloc.h>
|
||||
#include "ivytcl.h"
|
||||
|
||||
extern void cb_delete_channel(void *delete_read);
|
||||
extern void cb_read_channel(Channel ch, HANDLE fd, void *closure);
|
||||
|
||||
value ivy_TclmainLoop(value unit)
|
||||
{
|
||||
Tk_MainLoop();
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
|
||||
value ivy_TclchannelSetUp(value fd, value closure_name)
|
||||
{
|
||||
Channel c;
|
||||
value * closure = caml_named_value(String_val(closure_name));
|
||||
|
||||
c = IvyTclChannelSetUp((HANDLE)Int_val(fd), (void*)closure, cb_delete_channel, cb_read_channel);
|
||||
return Val_int(c);
|
||||
}
|
||||
|
||||
value ivy_TclchannelClose(value ch)
|
||||
{
|
||||
IvyTclChannelClose((Channel)Int_val(ch));
|
||||
return Val_unit;
|
||||
}
|
||||
@@ -0,0 +1,38 @@
|
||||
ivy-ocaml (1.1-7) unstable; urgency=low
|
||||
|
||||
* Updated for ocaml 3.10.2
|
||||
|
||||
-- Pascal Brisset (Hecto) <pascal.brisset@enac.fr> Fri, 23 May 2008 23:18:00 +0200
|
||||
|
||||
ivy-ocaml (1.1-6) unstable; urgency=low
|
||||
|
||||
* Updated for ocaml 3.10.1
|
||||
|
||||
-- Pascal Brisset (Hecto) <pascal.brisset@enac.fr> Mon, 25 Feb 2008 10:31:49 +0100
|
||||
|
||||
ivy-ocaml (1.1-5) unstable; urgency=low
|
||||
|
||||
* Updated for ocaml 3.10
|
||||
|
||||
-- Pascal Brisset (Hecto) <pascal.brisset@enac.fr> Tue, 04 Sep 2007 20:41:49 +0200
|
||||
|
||||
ivy-ocaml (1.1-4) unstable; urgency=low
|
||||
|
||||
* Updated for ocaml 3.09.2-6
|
||||
|
||||
-- Antoine Drouin (Poine) <poine@recherche.enac.fr> Fri, 04 Aug 2006 13:40:54 +0200
|
||||
|
||||
ivy-ocaml (1.1-3) unstable; urgency=low
|
||||
|
||||
* Updated for ivy 3.8
|
||||
|
||||
-- Antoine Drouin (Poine) <poine@recherche.enac.fr> Fri, 28 Jul 2006 13:40:54 +0200
|
||||
|
||||
ivy-ocaml (1.0-2) unstable; urgency=low
|
||||
|
||||
* Updated for ocaml 3.09
|
||||
|
||||
* Initial Release.
|
||||
|
||||
-- Pascal Brisset (Hecto) <pascal.brisset@enac.fr> Thu, 7 Oct 2004 13:40:54 +0200
|
||||
|
||||
@@ -0,0 +1,44 @@
|
||||
ivy-ocaml (1.1-10) unstable; urgency=low
|
||||
|
||||
* Updated for ocaml 3.11.2
|
||||
|
||||
-- Pascal Brisset (Hecto) <pascal.brisset@enac.fr> Thu, 25 Feb 2010 09:58:29 +0100
|
||||
|
||||
ivy-ocaml (1.1-7) unstable; urgency=low
|
||||
|
||||
* Updated for ocaml 3.10.2
|
||||
|
||||
-- Pascal Brisset (Hecto) <pascal.brisset@enac.fr> Fri, 23 May 2008 23:18:00 +0200
|
||||
|
||||
ivy-ocaml (1.1-6) unstable; urgency=low
|
||||
|
||||
* Updated for ocaml 3.10.1
|
||||
|
||||
-- Pascal Brisset (Hecto) <pascal.brisset@enac.fr> Mon, 25 Feb 2008 10:31:49 +0100
|
||||
|
||||
ivy-ocaml (1.1-5) unstable; urgency=low
|
||||
|
||||
* Updated for ocaml 3.10
|
||||
|
||||
-- Pascal Brisset (Hecto) <pascal.brisset@enac.fr> Tue, 04 Sep 2007 20:41:49 +0200
|
||||
|
||||
ivy-ocaml (1.1-4) unstable; urgency=low
|
||||
|
||||
* Updated for ocaml 3.09.2-6
|
||||
|
||||
-- Antoine Drouin (Poine) <poine@recherche.enac.fr> Fri, 04 Aug 2006 13:40:54 +0200
|
||||
|
||||
ivy-ocaml (1.1-3) unstable; urgency=low
|
||||
|
||||
* Updated for ivy 3.8
|
||||
|
||||
-- Antoine Drouin (Poine) <poine@recherche.enac.fr> Fri, 28 Jul 2006 13:40:54 +0200
|
||||
|
||||
ivy-ocaml (1.0-2) unstable; urgency=low
|
||||
|
||||
* Updated for ocaml 3.09
|
||||
|
||||
* Initial Release.
|
||||
|
||||
-- Pascal Brisset (Hecto) <pascal.brisset@enac.fr> Thu, 7 Oct 2004 13:40:54 +0200
|
||||
|
||||
@@ -0,0 +1 @@
|
||||
4
|
||||
@@ -0,0 +1,13 @@
|
||||
Source: ivy-ocaml
|
||||
Section: net
|
||||
Priority: optional
|
||||
Maintainer: Pascal Brisset (Hecto) <pascal.brisset@enac.fr>
|
||||
Build-Depends: debhelper (>= 4.0.0), ocaml-nox, ivy-c-dev (>=3.8), libglib2.0-dev, libpcre3-dev, ivy-c(>=3.8)
|
||||
Standards-Version: 3.6.1
|
||||
|
||||
Package: ivy-ocaml
|
||||
Architecture: any
|
||||
Depends: ${shlibs:Depends}, ${misc:Depends}, ocaml-nox-${F:OCamlABI}, ivy-c(>= 3.8)
|
||||
Description: Ocaml binding for the Ivy software bus
|
||||
This package provides the bindings for the Ivy software bus. Standalone
|
||||
linking and with the glib mainloop are provided.
|
||||
Executable
+99
@@ -0,0 +1,99 @@
|
||||
#!/usr/bin/make -f
|
||||
# -*- makefile -*-
|
||||
# Sample debian/rules that uses debhelper.
|
||||
# This file was originally written by Joey Hess and Craig Small.
|
||||
# As a special exception, when this file is copied by dh-make into a
|
||||
# dh-make output file, you may use that output file without restriction.
|
||||
# This special exception was added by Craig Small in version 0.37 of dh-make.
|
||||
|
||||
# Uncomment this to turn on verbose mode.
|
||||
#export DH_VERBOSE=1
|
||||
|
||||
|
||||
OCAMLABI := $(shell ocamlc -version)
|
||||
|
||||
|
||||
CFLAGS = -Wall -g
|
||||
|
||||
ifneq (,$(findstring noopt,$(DEB_BUILD_OPTIONS)))
|
||||
CFLAGS += -O0
|
||||
else
|
||||
CFLAGS += -O2
|
||||
endif
|
||||
|
||||
configure: configure-stamp
|
||||
configure-stamp:
|
||||
dh_testdir
|
||||
# Add here commands to configure the package.
|
||||
|
||||
touch configure-stamp
|
||||
|
||||
|
||||
build: build-stamp
|
||||
|
||||
build-stamp: configure-stamp
|
||||
dh_testdir
|
||||
|
||||
# Add here commands to compile the package.
|
||||
$(MAKE)
|
||||
#docbook-to-man debian/ivy-ocaml.sgml > ivy-ocaml.1
|
||||
|
||||
touch build-stamp
|
||||
|
||||
clean:
|
||||
dh_testdir
|
||||
dh_testroot
|
||||
rm -f build-stamp configure-stamp
|
||||
|
||||
# Add here commands to clean up after the build process.
|
||||
-$(MAKE) clean
|
||||
|
||||
dh_clean
|
||||
|
||||
install: build
|
||||
dh_testdir
|
||||
dh_testroot
|
||||
dh_clean -k
|
||||
dh_installdirs
|
||||
|
||||
# Add here commands to install the package into debian/ivy-ocaml.
|
||||
$(MAKE) install DESTDIR=$(CURDIR)/debian/ivy-ocaml
|
||||
|
||||
|
||||
# Build architecture-independent files here.
|
||||
binary-indep: build install
|
||||
# We have nothing to do by default.
|
||||
|
||||
# Build architecture-dependent files here.
|
||||
binary-arch: build install
|
||||
dh_testdir
|
||||
dh_testroot
|
||||
dh_installchangelogs
|
||||
dh_installdocs examples
|
||||
dh_installexamples
|
||||
# dh_install
|
||||
# dh_installmenu
|
||||
# dh_installdebconf
|
||||
# dh_installlogrotate
|
||||
# dh_installemacsen
|
||||
# dh_installpam
|
||||
# dh_installmime
|
||||
# dh_installinit
|
||||
# dh_installcron
|
||||
# dh_installinfo
|
||||
dh_installman
|
||||
dh_link
|
||||
dh_strip
|
||||
dh_compress
|
||||
dh_fixperms
|
||||
# dh_perl
|
||||
# dh_python
|
||||
# dh_makeshlibs
|
||||
dh_installdeb
|
||||
dh_shlibdeps
|
||||
dh_gencontrol -- -VF:OCamlABI="$(OCAMLABI)"
|
||||
dh_md5sums
|
||||
dh_builddeb
|
||||
|
||||
binary: binary-indep binary-arch
|
||||
.PHONY: build clean binary-indep binary-arch binary install configure
|
||||
@@ -0,0 +1 @@
|
||||
libivy 3 ivy-c
|
||||
@@ -0,0 +1,29 @@
|
||||
# $Id: Makefile,v 1.4 2006/07/28 16:38:53 poine Exp $
|
||||
|
||||
OCAMLC = ocamlc -I ..
|
||||
OCAMLMLI = ocamlc -I ..
|
||||
OCAMLOPT = ocamlopt
|
||||
OCAMLDEP=ocamldep
|
||||
|
||||
all: ivyprobe.out glibivyprobe.out
|
||||
|
||||
ivyprobe.out : ivyprobe.cmo ivyivyprobe.cmo
|
||||
$(OCAMLC) -custom -o $@ unix.cma ivy-ocaml.cma $^
|
||||
|
||||
glibivyprobe.out : ivyprobe.cmo glibivyprobe.cmo
|
||||
$(OCAMLC) -custom -o $@ unix.cma glibivy-ocaml.cma $^
|
||||
|
||||
#tkivyprobe.out : ivyprobe.cmo tkivyprobe.cmo
|
||||
# $(OCAMLC) -custom -o $@ unix.cma -I +labltk labltk.cma -I . $^
|
||||
#tkivyprobe.cmo : OCAMLFLAGS=-I +labltk
|
||||
|
||||
%.cmo : %.ml
|
||||
$(OCAMLC) -c $<
|
||||
|
||||
clean:
|
||||
\rm -f *.cm* *.o *.a .depend *~ *.out *.opt .depend *.so
|
||||
|
||||
.depend:
|
||||
$(OCAMLDEP) $(INCLUDES) *.mli *.ml > .depend
|
||||
|
||||
include .depend
|
||||
@@ -0,0 +1,9 @@
|
||||
(* $Id: glibivyprobe.ml,v 1.1 2004/10/18 10:55:37 brisset Exp $ *)
|
||||
|
||||
let _ =
|
||||
Ivyprobe.init ();
|
||||
try
|
||||
ignore (GlibIvy.set_up_channel Unix.stdin Ivy.stop (fun _ -> Ivyprobe.read stdin));
|
||||
GlibIvy.main ()
|
||||
with
|
||||
End_of_file -> Ivy.stop ()
|
||||
@@ -0,0 +1,8 @@
|
||||
let _ =
|
||||
Ivyprobe.init ();
|
||||
try
|
||||
ignore (IvyLoop.set_up_channel Unix.stdin Ivy.stop (fun _ -> Ivyprobe.read stdin));
|
||||
IvyLoop.main ()
|
||||
with
|
||||
End_of_file -> Ivy.stop ()
|
||||
|
||||
@@ -0,0 +1,42 @@
|
||||
(* $Id: ivyprobe.ml,v 1.1 2004/10/18 10:55:37 brisset Exp $ *)
|
||||
|
||||
let print_message app message =
|
||||
Printf.printf "%s sent" (Ivy.name_of_client app);
|
||||
Array.iter (fun s -> Printf.printf " '%s'" s) message;
|
||||
print_newline ()
|
||||
|
||||
let read = fun channel ->
|
||||
let l = input_line channel in
|
||||
Ivy.send l
|
||||
|
||||
let watch_clients c e =
|
||||
let dis = match e with Ivy.Connected -> "" | Ivy.Disconnected -> "dis" in
|
||||
Printf.printf "%s %sconnected from %s\n"
|
||||
(Ivy.name_of_client c)
|
||||
dis
|
||||
(Ivy.host_of_client c);
|
||||
flush stdout
|
||||
|
||||
let init = fun () ->
|
||||
let regexp = ref ""
|
||||
and name = ref "MLIVYPROBE"
|
||||
and port = ref 2010
|
||||
and domain = ref "127.255.255.255" in
|
||||
Arg.parse
|
||||
[ "-b", Arg.Int (fun x -> port := x), "<Port number>\tDefault is 2010, unused if IVYBUS is set";
|
||||
"-domain", Arg.String (fun x -> domain := x), "<Network address>\tDefault is 127.255.255.255, unused if IVYBUS is set";
|
||||
"-n", Arg.String (fun s -> name := s), "<Name of the prober>\tDefault is MLIVYPROBE"]
|
||||
(fun s -> regexp := s)
|
||||
"Usage: ";
|
||||
|
||||
let bus =
|
||||
try Sys.getenv "IVYBUS" with
|
||||
Not_found -> Printf.sprintf "%s:%d" !domain !port in
|
||||
Ivy.init !name "READY" watch_clients;
|
||||
Ivy.start bus;
|
||||
|
||||
Printf.printf "\nEnd of file to stop\n\n"; flush stdout;
|
||||
|
||||
IvyLoop.timer (-1) 1000 (fun _ -> Ivy.send "Coucou");
|
||||
|
||||
ignore (Ivy.bind print_message !regexp)
|
||||
@@ -0,0 +1,10 @@
|
||||
let _ =
|
||||
Ivyprobe.init ();
|
||||
let top = Tk.openTk () in
|
||||
try
|
||||
ignore (TkIvy.set_up_channel Unix.stdin Ivy.stop (fun _ -> Ivyprobe.read stdin));
|
||||
TkIvy.main ()
|
||||
with
|
||||
End_of_file -> Ivy.stop ()
|
||||
|
||||
|
||||
@@ -0,0 +1,8 @@
|
||||
|
||||
type channel
|
||||
external main : unit -> unit = "ivy_GtkmainLoop"
|
||||
external ext_channelSetUp : Unix.file_descr -> string -> channel = "ivy_GtkchannelSetUp"
|
||||
let set_up_channel fd delete read =
|
||||
ext_channelSetUp fd (Ivy.cb_register read)
|
||||
external close_channel : channel -> unit = "ivy_GtkchannelClose"
|
||||
|
||||
@@ -0,0 +1,13 @@
|
||||
val main : unit -> unit
|
||||
(** Glib main loop *)
|
||||
|
||||
type channel
|
||||
(** Channel handled by the main loop *)
|
||||
|
||||
val set_up_channel : Unix.file_descr -> (unit -> unit) -> (channel -> unit) -> channel
|
||||
(** [set_up_channel fd delete read] gives the opportunity to the main loop
|
||||
to call [read] when data is available on [fd] and [delete] when [fd] is
|
||||
closed *)
|
||||
|
||||
val close_channel : channel -> unit
|
||||
(** Stops the handling of a channel by the main loop *)
|
||||
@@ -0,0 +1,81 @@
|
||||
(* $Id: ivy.ml,v 1.7 2004/09/11 17:06:59 poine Exp $ *)
|
||||
|
||||
|
||||
type binding
|
||||
type client
|
||||
type client_event = Connected | Disconnected
|
||||
type cb = client -> string array -> unit
|
||||
type client_cb = client -> client_event -> unit
|
||||
|
||||
external send : string -> unit = "ivy_sendMsg"
|
||||
external stop : unit -> unit = "ivy_stop"
|
||||
external ext_init : string -> string -> string -> unit = "ivy_init"
|
||||
|
||||
|
||||
let gensym = let n = ref 0 in fun p -> incr n; p ^ string_of_int !n
|
||||
let cb_register = fun closure ->
|
||||
let s = gensym "callback_" in
|
||||
Callback.register s closure;
|
||||
s
|
||||
|
||||
let init = fun name ready ccb ->
|
||||
ext_init name ready (cb_register ccb)
|
||||
|
||||
|
||||
external start : string -> unit = "ivy_start"
|
||||
external ext_bind : string -> string -> binding = "ivy_bindMsg"
|
||||
|
||||
let bind = fun (cb:cb) regexp ->
|
||||
ext_bind (cb_register cb) regexp
|
||||
|
||||
external unbind : binding -> unit = "ivy_unbindMsg"
|
||||
|
||||
|
||||
external name_of_client : client -> string = "ivy_name_of_client"
|
||||
external host_of_client : client -> string = "ivy_host_of_client"
|
||||
|
||||
|
||||
|
||||
let marshal_tag = "MARSHAL"
|
||||
|
||||
let hexa_char = fun c ->
|
||||
assert(0 <= c && c < 16);
|
||||
if c < 10 then
|
||||
Char.chr (c + Char.code '0')
|
||||
else
|
||||
Char.chr (c + Char.code 'A' - 10)
|
||||
|
||||
let hexa_code = fun c ->
|
||||
if '0' <= c && c <= '9' then
|
||||
Char.code c - Char.code '0'
|
||||
else if 'A' <= c && c <= 'F' then
|
||||
Char.code c - Char.code 'A' + 10
|
||||
else failwith (Printf.sprintf "hexa_code: %c" c)
|
||||
|
||||
|
||||
let hexa_of_string = fun s ->
|
||||
let n = String.length s in
|
||||
let h = String.create (n*2) in
|
||||
for i = 0 to n - 1 do
|
||||
let c = Char.code s.[i] in
|
||||
h.[2*i] <- hexa_char (c lsr 4);
|
||||
h.[2*i+1] <- hexa_char (c land 0xf)
|
||||
done;
|
||||
h
|
||||
|
||||
let string_of_hexa = fun h ->
|
||||
let n = String.length h / 2 in
|
||||
let s = String.create n in
|
||||
for i = 0 to n - 1 do
|
||||
s.[i] <- Char.chr (hexa_code h.[2*i] lsl 4 + hexa_code h.[2*i+1])
|
||||
done;
|
||||
s
|
||||
|
||||
|
||||
let send_data = fun tag value ->
|
||||
let s = hexa_of_string (Marshal.to_string value []) in
|
||||
send (Printf.sprintf "%s %s %s" marshal_tag tag s)
|
||||
|
||||
let data_bind = fun cb tag ->
|
||||
let r = Printf.sprintf "%s %s (.*)" marshal_tag tag in
|
||||
bind (fun c a -> cb c (Marshal.from_string (string_of_hexa a.(0)) 0)) r
|
||||
@@ -0,0 +1,57 @@
|
||||
(** $Id: ivy.mli,v 1.8 2004/09/11 22:23:32 brisset Exp $ *)
|
||||
|
||||
(** Interface for ivy-c (http://www.tls.cena.fr/products/ivy/) *)
|
||||
|
||||
type binding
|
||||
(** Identification of bindings (callback/message) *)
|
||||
|
||||
type client
|
||||
(** Identification of client applications *)
|
||||
|
||||
val name_of_client : client -> string
|
||||
val host_of_client : client -> string
|
||||
(** Access to client identification *)
|
||||
|
||||
type client_event = Connected | Disconnected
|
||||
(** Status of (de)connecting applications *)
|
||||
|
||||
type cb = client -> string array -> unit
|
||||
(** Profile of message binding callback *)
|
||||
|
||||
type client_cb = client -> client_event -> unit
|
||||
(** Profile of callback for (de)connecting applications *)
|
||||
|
||||
val init : string -> string -> client_cb -> unit
|
||||
(** [init name ready cb] initializes the application as an IVY client,
|
||||
identifying itself with [name], first sending the [ready] message. [cb]
|
||||
will be called each time a new application (de)connects to this IVY bus. *)
|
||||
|
||||
val start : string -> unit
|
||||
(** [start bus] starts the connection to machine/network/port specified in
|
||||
[bus]. Syntax for [bus] is ["IPaddress:port"] *)
|
||||
|
||||
val bind : cb -> string -> binding
|
||||
(** [bind cb regexp] binds callback [cb] to messages matching the [regexp]
|
||||
regular expression. [cb] will be called with the array of matching groups
|
||||
defined in [regexp]. *)
|
||||
|
||||
val send : string -> unit
|
||||
(** [send message] sends a message to the IVY initialized bus *)
|
||||
|
||||
val stop : unit -> unit
|
||||
(** Exits the main loop *)
|
||||
|
||||
val unbind : binding -> unit
|
||||
(** Removes a message binding *)
|
||||
|
||||
val send_data : string -> 'a -> unit
|
||||
(** [send_data tag value] marshals [value] into a string and sends it with
|
||||
[tag] over the IVY bus *)
|
||||
|
||||
val data_bind : (client -> 'a -> unit) -> string -> binding
|
||||
(** [data_bind cb tag] binds [cb] to IVY messages sent with [send_data] and
|
||||
tagged with [tag]. This operation IS NOT type safe.*)
|
||||
|
||||
(***)
|
||||
|
||||
val cb_register : ('a -> 'b) -> string
|
||||
@@ -0,0 +1,22 @@
|
||||
type channel
|
||||
type delete_channel_cb = unit -> unit
|
||||
type timer
|
||||
type timer_cb = timer -> unit
|
||||
|
||||
external ext_timer : int -> int -> string -> timer = "ivy_timerRepeatafter"
|
||||
|
||||
let timer = fun n t cb ->
|
||||
let closure_name = Ivy.cb_register cb in
|
||||
ext_timer n t closure_name
|
||||
|
||||
external remove_timer : timer -> unit = "ivy_timerRemove"
|
||||
|
||||
external main : unit -> unit = "ivy_mainLoop"
|
||||
|
||||
external ext_channelSetUp : Unix.file_descr -> string -> channel = "ivy_channelSetUp"
|
||||
external close_channel : channel -> unit = "ivy_channelClose"
|
||||
|
||||
|
||||
type read_channel_cb = channel -> unit
|
||||
let set_up_channel fd delete read =
|
||||
ext_channelSetUp fd (Ivy.cb_register read)
|
||||
@@ -0,0 +1,25 @@
|
||||
val main : unit -> unit
|
||||
(** Starts the loop which handles asynchronous communications. The standard
|
||||
version does not return until IVY is explictly stopped *)
|
||||
|
||||
type channel
|
||||
(** Channel handled by the main loop *)
|
||||
|
||||
val set_up_channel : Unix.file_descr -> (unit -> unit) -> (channel -> unit) -> channel
|
||||
(** [set_up_channel fd delete read] gives the opportunity to the main loop
|
||||
to call [read] when data is available on [fd] and [delete] when [fd] is
|
||||
closed *)
|
||||
|
||||
val close_channel : channel -> unit
|
||||
(** Stops the handling of a channel by the main loop *)
|
||||
|
||||
type timer
|
||||
(** Timer identifier *)
|
||||
|
||||
val timer : int -> int -> (timer -> unit) -> timer
|
||||
(** [timer n ms cb] sets a timer which will call [n] times the callback [cb]
|
||||
with a period of [ms] milliseconds *)
|
||||
|
||||
val remove_timer : timer -> unit
|
||||
(** [remove_timer t] stops the timer [t] *)
|
||||
|
||||
@@ -0,0 +1,8 @@
|
||||
|
||||
type channel
|
||||
external main : unit -> unit = "ivy_TclmainLoop"
|
||||
external ext_channelSetUp : Unix.file_descr -> string -> channel = "ivy_TclchannelSetUp"
|
||||
let set_up_channel fd delete read =
|
||||
ext_channelSetUp fd (Ivy.cb_register read)
|
||||
external close_channel : channel -> unit = "ivy_TclchannelClose"
|
||||
|
||||
@@ -0,0 +1,13 @@
|
||||
val main : unit -> unit
|
||||
(** Tk main loop *)
|
||||
|
||||
type channel
|
||||
(** Channel handled by the main loop *)
|
||||
|
||||
val set_up_channel : Unix.file_descr -> (unit -> unit) -> (channel -> unit) -> channel
|
||||
(** [set_up_channel fd delete read] gives the opportunity to the main loop
|
||||
to call [read] when data is available on [fd] and [delete] when [fd] is
|
||||
closed *)
|
||||
|
||||
val close_channel : channel -> unit
|
||||
(** Stops the handling of a channel by the main loop *)
|
||||
Reference in New Issue
Block a user