diff options
author | hattenberger | 2013-03-27 13:17:19 +0000 |
---|---|---|
committer | hattenberger | 2013-03-27 13:17:19 +0000 |
commit | a17272283c803e13258e5dc6b19533c672ceee18 (patch) | |
tree | 0fa7737e21fe1147c860a84b18676cd99a80fdb1 /trunk | |
parent | 003d66dc1fabc063372e4f03265935d0ccaefd78 (diff) | |
download | ivy-ocaml-a17272283c803e13258e5dc6b19533c672ceee18.zip ivy-ocaml-a17272283c803e13258e5dc6b19533c672ceee18.tar.gz ivy-ocaml-a17272283c803e13258e5dc6b19533c672ceee18.tar.bz2 ivy-ocaml-a17272283c803e13258e5dc6b19533c672ceee18.tar.xz |
some fixes in ivy-ocaml tag 1.2
Diffstat (limited to 'trunk')
-rw-r--r-- | trunk/META.glibivy | 4 | ||||
-rw-r--r-- | trunk/META.ivy | 4 | ||||
-rw-r--r-- | trunk/Makefile | 137 | ||||
-rw-r--r-- | trunk/README | 18 | ||||
-rw-r--r-- | trunk/cglibivy.c | 43 | ||||
-rw-r--r-- | trunk/civy.c | 93 | ||||
-rw-r--r-- | trunk/civyloop.c | 70 | ||||
-rw-r--r-- | trunk/ctkivy.c | 36 | ||||
-rw-r--r-- | trunk/debian/changelog | 86 | ||||
-rw-r--r-- | trunk/debian/compat | 1 | ||||
-rw-r--r-- | trunk/debian/control | 18 | ||||
-rw-r--r-- | trunk/debian/copyright | 27 | ||||
-rwxr-xr-x | trunk/debian/rules | 17 | ||||
-rw-r--r-- | trunk/debian/source/format | 1 | ||||
-rw-r--r-- | trunk/examples/Makefile | 29 | ||||
-rw-r--r-- | trunk/examples/glibivyprobe.ml | 9 | ||||
-rw-r--r-- | trunk/examples/ivyivyprobe.ml | 8 | ||||
-rw-r--r-- | trunk/examples/ivyprobe.ml | 40 | ||||
-rw-r--r-- | trunk/examples/tkivyprobe.ml | 10 | ||||
-rw-r--r-- | trunk/glibIvy.ml | 8 | ||||
-rw-r--r-- | trunk/glibIvy.mli | 13 | ||||
-rw-r--r-- | trunk/ivy.ml | 81 | ||||
-rw-r--r-- | trunk/ivy.mli | 57 | ||||
-rw-r--r-- | trunk/ivyLoop.ml | 22 | ||||
-rw-r--r-- | trunk/ivyLoop.mli | 25 | ||||
-rw-r--r-- | trunk/tkIvy.ml | 8 | ||||
-rw-r--r-- | trunk/tkIvy.mli | 13 |
27 files changed, 878 insertions, 0 deletions
diff --git a/trunk/META.glibivy b/trunk/META.glibivy new file mode 100644 index 0000000..50818cb --- /dev/null +++ b/trunk/META.glibivy @@ -0,0 +1,4 @@ +version="1.2" +directory="+ivy" +archive(byte)="glibivy-ocaml.cma" +archive(native)="glibivy-ocaml.cmxa" diff --git a/trunk/META.ivy b/trunk/META.ivy new file mode 100644 index 0000000..553684e --- /dev/null +++ b/trunk/META.ivy @@ -0,0 +1,4 @@ +version="1.2" +directory="+ivy" +archive(byte)="ivy-ocaml.cma" +archive(native)="ivy-ocaml.cmxa" diff --git a/trunk/Makefile b/trunk/Makefile new file mode 100644 index 0000000..84d8bd4 --- /dev/null +++ b/trunk/Makefile @@ -0,0 +1,137 @@ +# $Id$ + +DESTDIR = / + +DEBUG = n + + +OCAMLC = ocamlc +OCAMLMLI = ocamlc +OCAMLOPT = ocamlopt -unsafe +OCAMLDEP = ocamldep +OCAMLMKLIB = ocamlmklib + +ifeq ($(DEBUG),y) +OCAMLFLAGS = -g +else +OCAMLFLAGS = +endif + +OCAMLOPTFLAGS= +CFLAGS+=-Wall +OCAMLINC=-I `ocamlc -where` +GLIBINC=`pkg-config --cflags glib-2.0` + +LBITS := $(shell getconf LONG_BIT) +ifeq ($(LBITS),64) + FPIC=-fPIC +endif + +OUTDIR = ivy + + +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) + +UNAME = $(shell uname -s) + +ifeq ("$(UNAME)","Darwin") + LIBRARYS = -L/opt/local/lib +endif + +LIBS = ivy-ocaml.cma glibivy-ocaml.cma +XLIBS = ivy-ocaml.cmxa glibivy-ocaml.cmxa +TKLIBS = tkivy.cma tkivy.cmxa +STATIC = libivy-ocaml.a libglibivy-ocaml.a ivy-ocaml.a glibivy-ocaml.a +GLIBIVYCMI = glibIvy.cmi +METAFILES = META.ivy META.glibivy + +all : $(LIBS) $(XLIBS) + +deb : + dpkg-buildpackage -rfakeroot + +ivy : ivy-ocaml.cma ivy-ocaml.cmxa +glibivy : glibivy-ocaml.cma glibivy-ocaml.cma +tkivy : $(TKLIBS) + +INST_FILES = $(IVYCMI) $(IVYMLI) $(GLIBIVYCMI) $(LIBS) $(XLIBS) $(STATIC) +# tkIvy.cmi libtkivy.a dlltkivy.so tkivy.a +STUBLIBS = dllivy-ocaml.so dllglibivy-ocaml.so + +install : $(LIBS) + mkdir -p $(DESTDIR)/`ocamlc -where`/$(OUTDIR) + cp $(INST_FILES) $(DESTDIR)/`ocamlc -where`/$(OUTDIR) + mkdir -p $(DESTDIR)/`ocamlc -where`/stublibs + cp $(STUBLIBS) $(DESTDIR)/`ocamlc -where`/stublibs + mkdir -p $(DESTDIR)/`ocamlc -where`/METAS + cp $(METAFILES) $(DESTDIR)/`ocamlc -where`/METAS + mkdir -p $(DESTDIR)/`ocamlc -where` + $(foreach file,$(LIBS) $(XLIBS) $(STATIC) $(IVYCMI) $(IVYMLI) $(GLIBIVYCMI), \ + cd $(DESTDIR)/`ocamlc -where`; ln -s ivy/$(file) $(file);) + +desinstall : + cd `ocamlc -where`; rm -f $(INST_FILES); rm -f METAS/$(METAFILES) + +ivy-ocaml.cma : $(IVYCMO) civy.o civyloop.o + $(OCAMLMKLIB) -o ivy-ocaml $^ $(LIBRARYS) -livy + +ivy-ocaml.cmxa : $(IVYCMX) civy.o civyloop.o + $(OCAMLMKLIB) -o ivy-ocaml $^ $(LIBRARYS) -livy + +glibivy-ocaml.cma : $(GLIBIVYCMO) civy.o cglibivy.o + $(OCAMLMKLIB) -o glibivy-ocaml $^ $(LIBRARYS) -lglibivy `pkg-config --libs glib-2.0` -lpcre + +glibivy-ocaml.cmxa : $(GLIBIVYCMX) civy.o cglibivy.o + $(OCAMLMKLIB) -o glibivy-ocaml $^ $(LIBRARYS) -lglibivy `pkg-config --libs glib-2.0` -lpcre + +tkivy-ocaml.cma : $(TKIVYCMO) civy.o ctkivy.o + $(OCAMLMKLIB) -o tkivy-ocaml $^ $(LIBRARYS) -livy -ltclivy + +tkivy-ocaml.cmxa : $(TKIVYCMX) civy.o ctkivy.o + $(OCAMLMKLIB) -o tkivy-ocaml $^ $(LIBRARYS) -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 $(FPIC) -I /opt/local/include/ $(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.cma $< -cclib -livy +.cmx.opt : + $(OCAMLOPT) -o $@ unix.cmxa -I . ivy.cmxa $< -cclib -livy + +clean: + \rm -fr *.cm* *.o *.a .depend *~ *.out *.opt .depend *.so *-stamp debian/ivy-ocaml debian/files debian/ivy-ocaml.debhelper.log debian/ivy-ocaml.substvars debian/*~ + +.depend: + $(OCAMLDEP) $(INCLUDES) *.mli *.ml > .depend + +include .depend diff --git a/trunk/README b/trunk/README new file mode 100644 index 0000000..03b8864 --- /dev/null +++ b/trunk/README @@ -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: Gautier Hattenberger (gautier dot hattenberger at enac dot fr) diff --git a/trunk/cglibivy.c b/trunk/cglibivy.c new file mode 100644 index 0000000..8241b70 --- /dev/null +++ b/trunk/cglibivy.c @@ -0,0 +1,43 @@ +#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 <Ivy/version.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, IVY_HANDLE fd, void *closure); +extern void cb_write_channel(Channel ch, IVY_HANDLE fd, void *closure); + +value ivy_GtkchannelSetUp(value fd, value closure_name) +{ + Channel c; + value * closure = caml_named_value(String_val(closure_name)); + +#if IVYMINOR_VERSION == 8 + c = IvyChannelAdd((IVY_HANDLE)Int_val(fd), (void*)closure, cb_delete_channel, cb_read_channel); +#else + c = IvyChannelAdd((IVY_HANDLE)Int_val(fd), (void*)closure, cb_delete_channel, cb_read_channel, cb_write_channel); +#endif + return Val_int(c); +} + +value ivy_GtkchannelClose(value ch) +{ + IvyChannelRemove((Channel)Long_val(ch)); + return Val_unit; +} diff --git a/trunk/civy.c b/trunk/civy.c new file mode 100644 index 0000000..563f7ec --- /dev/null +++ b/trunk/civy.c @@ -0,0 +1,93 @@ +#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_long(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_long(id); +} + +value ivy_unbindMsg(value id) +{ + IvyUnbindMsg((MsgRcvPtr)Long_val(id)); + return Val_unit; +} + +value ivy_name_of_client(value c) +{ + return copy_string(IvyGetApplicationName((IvyClientPtr)Long_val(c))); +} +value ivy_host_of_client(value c) +{ + return copy_string(IvyGetApplicationHost((IvyClientPtr)Long_val(c))); +} + +void cb_delete_channel(void *delete_read) +{ +} + +void cb_write_channel(Channel ch, IVY_HANDLE fd, void *closure) +{ +} + +void cb_read_channel(Channel ch, IVY_HANDLE fd, void *closure) +{ + callback(*(value*)closure, Val_int(ch)); +} diff --git a/trunk/civyloop.c b/trunk/civyloop.c new file mode 100644 index 0000000..083b104 --- /dev/null +++ b/trunk/civyloop.c @@ -0,0 +1,70 @@ +#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 <Ivy/version.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) +{ +#if IVYMINOR_VERSION == 8 + IvyMainLoop (NULL,NULL); +#else + IvyMainLoop (); +#endif + return Val_unit; +} + +void timer_cb(TimerId id, void *data, unsigned long delta) +{ + value closure = *(value*)data; + callback(closure, Val_long(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 */ + +extern void cb_delete_channel(void *delete_read); +extern void cb_read_channel(Channel ch, IVY_HANDLE fd, void *closure); +extern void cb_write_channel(Channel ch, IVY_HANDLE fd, void *closure); + + +value ivy_channelSetUp(value fd, value closure_name) +{ + Channel c; + value * closure = caml_named_value(String_val(closure_name)); + +#if IVYMINOR_VERSION == 8 + c = IvyChannelAdd((IVY_HANDLE)Int_val(fd), (void*)closure, cb_delete_channel, cb_read_channel); +#else + c = IvyChannelAdd((IVY_HANDLE)Int_val(fd), (void*)closure, cb_delete_channel, cb_read_channel, cb_write_channel); +#endif + return Val_int(c); +} + +value ivy_timerRemove(value t) +{ + TimerRemove((TimerId)Long_val(t)); + return Val_unit; +} + + +value ivy_channelClose(value ch) +{ + IvyChannelRemove((Channel)Long_val(ch)); + return Val_unit; +} diff --git a/trunk/ctkivy.c b/trunk/ctkivy.c new file mode 100644 index 0000000..87b7eb6 --- /dev/null +++ b/trunk/ctkivy.c @@ -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, IVY_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((IVY_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; +} diff --git a/trunk/debian/changelog b/trunk/debian/changelog new file mode 100644 index 0000000..dbcced8 --- /dev/null +++ b/trunk/debian/changelog @@ -0,0 +1,86 @@ +ivy-ocaml (1.2) unstable; urgency=low + + * Add META file for ocamlfind support + * Move installed files in ivy subdirectory + * Remove -ocaml suffix + * Symbolic link for backward compatibility + * Update for ocaml 3.12.1 + * Increase minor version number + + -- Gautier Hattenberger <gautier.hattenberger@enac.fr> Thu, 21 Feb 2013 09:53:31 +0100 + +ivy-ocaml (1.1-14~precise) precise; urgency=low + + * updated version for ubuntu precise ppa build + + -- Felix Ruess <felix.ruess@gmail.com> Wed, 04 Apr 2012 15:27:59 +0200 + +ivy-ocaml (1.1-13) unstable; urgency=low + + * Update for ocaml 1.12.0 + + -- Gautier Hattenberger <gautier.hattenberger@enac.fr> Tue, 18 Oct 2011 17:53:31 +0100 + +ivy-ocaml (1.1-12.1) unstable; urgency=low + + * Non-maintainer upload + * Updated all debian files to use dh (debhelper 7) + + -- Felix Ruess <felix.ruess@gmail.com> Fri, 21 Oct 2011 19:47:25 +0200 + +ivy-ocaml (1.1-12) unstable; urgency=low + + * Support for ivy-c_3.11.8 + + -- Gautier Hattenberger <gautier.hattenberger@enac.fr> Wed, 02 Feb 2011 17:49:31 +0100 + +ivy-ocaml (1.1-11) unstable; urgency=low + + * Support of ivy-c_3.11.6, OSX and Linux 64bit + + -- Gautier Hattenberger <gautier.hattenberger@enac.fr> Wed, 1 Dec 2010 10:43:29 +0100 + +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 + diff --git a/trunk/debian/compat b/trunk/debian/compat new file mode 100644 index 0000000..7f8f011 --- /dev/null +++ b/trunk/debian/compat @@ -0,0 +1 @@ +7 diff --git a/trunk/debian/control b/trunk/debian/control new file mode 100644 index 0000000..4bba10f --- /dev/null +++ b/trunk/debian/control @@ -0,0 +1,18 @@ +Source: ivy-ocaml +Section: net +Priority: optional +Maintainer: Gautier Hattenberger <gautier.hattenberger@enac.fr> +Build-Depends: debhelper (>= 7.0.50~), dh-ocaml (>= 0.9.0), ocaml-nox, libglib2.0-dev, libpcre3-dev, ivy-c-dev (>=3.11) +Standards-Version: 3.9.2 +Homepage: http://www2.tls.cena.fr/products/ivy/ +Vcs-Svn: http://svn.tls.cena.fr/svn/ivy/ivy-ocaml/trunk +Vcs-Browser: http://svn.tls.cena.fr/wsvn/ivy/ivy-ocaml/trunk/#_ivy-ocaml_trunk_ + +Package: ivy-ocaml +Architecture: any +Depends: ${ocaml:Depends}, ${shlibs:Depends}, ${misc:Depends}, ivy-c(>= 3.11) +Suggests: ocaml-findlib +Provides: ${ocaml:Provides} +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. diff --git a/trunk/debian/copyright b/trunk/debian/copyright new file mode 100644 index 0000000..5ee9dea --- /dev/null +++ b/trunk/debian/copyright @@ -0,0 +1,27 @@ +Format: http://dep.debian.net/deps/dep5 +Upstream-Name: ivy-ocaml +Source: http://www2.tls.cena.fr/products/ivy/ + +Files: * +Copyright: 2005-2011 CENA +License: + LGPL + see also http://www2.tls.cena.fr/products/ivy/download/legalissues.html +Files: debian/* +Copyright: 2011 Felix Ruess <felix.ruess@gmail.com> +License: GPL-2+ + This package is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + . + This package is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + . + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/> + . + On Debian systems, the complete text of the GNU General + Public License version 2 can be found in "/usr/share/common-licenses/GPL-2". diff --git a/trunk/debian/rules b/trunk/debian/rules new file mode 100755 index 0000000..6827cc6 --- /dev/null +++ b/trunk/debian/rules @@ -0,0 +1,17 @@ +#!/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 + +%: + dh $@ --with ocaml + +override_dh_auto_install : + $(MAKE) install DESTDIR=$(CURDIR)/debian/ivy-ocaml + diff --git a/trunk/debian/source/format b/trunk/debian/source/format new file mode 100644 index 0000000..89ae9db --- /dev/null +++ b/trunk/debian/source/format @@ -0,0 +1 @@ +3.0 (native) diff --git a/trunk/examples/Makefile b/trunk/examples/Makefile new file mode 100644 index 0000000..d110fd0 --- /dev/null +++ b/trunk/examples/Makefile @@ -0,0 +1,29 @@ +# $Id$ + +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 diff --git a/trunk/examples/glibivyprobe.ml b/trunk/examples/glibivyprobe.ml new file mode 100644 index 0000000..fb7e1f3 --- /dev/null +++ b/trunk/examples/glibivyprobe.ml @@ -0,0 +1,9 @@ +(* $Id$ *) + +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 () diff --git a/trunk/examples/ivyivyprobe.ml b/trunk/examples/ivyivyprobe.ml new file mode 100644 index 0000000..b51a708 --- /dev/null +++ b/trunk/examples/ivyivyprobe.ml @@ -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 () + diff --git a/trunk/examples/ivyprobe.ml b/trunk/examples/ivyprobe.ml new file mode 100644 index 0000000..47bd2aa --- /dev/null +++ b/trunk/examples/ivyprobe.ml @@ -0,0 +1,40 @@ +(* $Id$ *) + +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; + + ignore (Ivy.bind print_message !regexp) diff --git a/trunk/examples/tkivyprobe.ml b/trunk/examples/tkivyprobe.ml new file mode 100644 index 0000000..67ee3aa --- /dev/null +++ b/trunk/examples/tkivyprobe.ml @@ -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 () + + diff --git a/trunk/glibIvy.ml b/trunk/glibIvy.ml new file mode 100644 index 0000000..17919c5 --- /dev/null +++ b/trunk/glibIvy.ml @@ -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" + diff --git a/trunk/glibIvy.mli b/trunk/glibIvy.mli new file mode 100644 index 0000000..3df31b6 --- /dev/null +++ b/trunk/glibIvy.mli @@ -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 *) diff --git a/trunk/ivy.ml b/trunk/ivy.ml new file mode 100644 index 0000000..f031252 --- /dev/null +++ b/trunk/ivy.ml @@ -0,0 +1,81 @@ +(* $Id$ *) + + +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 diff --git a/trunk/ivy.mli b/trunk/ivy.mli new file mode 100644 index 0000000..9bbab0c --- /dev/null +++ b/trunk/ivy.mli @@ -0,0 +1,57 @@ +(** $Id$ *) + +(** 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 diff --git a/trunk/ivyLoop.ml b/trunk/ivyLoop.ml new file mode 100644 index 0000000..5808de4 --- /dev/null +++ b/trunk/ivyLoop.ml @@ -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) diff --git a/trunk/ivyLoop.mli b/trunk/ivyLoop.mli new file mode 100644 index 0000000..5c84843 --- /dev/null +++ b/trunk/ivyLoop.mli @@ -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] *) + diff --git a/trunk/tkIvy.ml b/trunk/tkIvy.ml new file mode 100644 index 0000000..907baa9 --- /dev/null +++ b/trunk/tkIvy.ml @@ -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" + diff --git a/trunk/tkIvy.mli b/trunk/tkIvy.mli new file mode 100644 index 0000000..9d56a4d --- /dev/null +++ b/trunk/tkIvy.mli @@ -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 *) |