5 files changed, 186 insertions, 0 deletions
diff --git a/Examples/ocaml/shapes/Makefile b/Examples/ocaml/shapes/Makefile
new file mode 100644
index 0000000..31f9934
--- /dev/null
+++ b/Examples/ocaml/shapes/Makefile
@@ -0,0 +1,34 @@
+TOP        = ../..
+SWIG       = $(TOP)/../preinst-swig
+SWIGOPT    = 
+SRCS       = example.c
+TARGET     = example
+INTERFACE  = example.i
+MLFILE     = example.ml
+PROGFILE   = example_prog.ml
+OBJS       = example.o
+
+all:: static static_top
+
+static::
+	$(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \
+	SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' \
+	MLFILE='$(MLFILE)' PROGFILE='$(PROGFILE)' OBJS='$(OBJS)' \
+	ocaml_static_cpp
+
+static_top::
+	$(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \
+	SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' \
+	MLFILE='$(MLFILE)' PROGFILE='$(PROGFILE)' OBJS='$(OBJS)' \
+	ocaml_static_cpp_toplevel
+
+dynamic::
+	$(MAKE) -f $(TOP)/Makefile SRCS='$(SRCS)' SWIG='$(SWIG)' \
+	SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)'
+	MLFILE='$(MLFILE)' PROGFILE='$(PROGFILE)' OBJS='$(OBJS)' \
+	ocaml_dynamic_cpp
+
+clean::
+	$(MAKE) -f $(TOP)/Makefile MLFILE='$(MLFILE)' ocaml_clean
+
+check: all
diff --git a/Examples/ocaml/shapes/example.c b/Examples/ocaml/shapes/example.c
new file mode 100644
index 0000000..bf0fff9
--- /dev/null
+++ b/Examples/ocaml/shapes/example.c
@@ -0,0 +1,48 @@
+/* File : example.c */
+#include <stdio.h>
+#include "example.h"
+
+shape::~shape() { }
+
+bool shape::cover( double x, double y ) { return false; }
+
+void draw_shape_coverage( shape *s, int div_x, int div_y ) {
+    double i,j;
+
+    for( i = 0; i < 1.0; i += 1.0 / ((float)div_y) ) {
+	for( j = 0; j < 1.0; j += 1.0 / ((float)div_x) ) {
+	    if( s->cover( j,i ) ) putchar( 'x' ); else putchar( ' ' );
+	}
+	printf( "\n" );
+    }
+}
+
+void draw_depth_map( volume *v, int div_x, int div_y ) {
+    double i,j;
+    char depth_map_chars[] = "#*+o;:,. ";
+    double lowbound, highbound;
+    double current = 0.0;
+    bool bounds_set = false;
+
+    for( i = 0; i < 1.0; i += 1.0 / ((float)div_y) ) {
+	for( j = 0; j < 1.0; j += 1.0 / ((float)div_x) ) {
+	    current = v->depth( j,i );
+	    if( !bounds_set ) { 
+		lowbound = current; highbound = current; bounds_set = true;
+	    }
+	    if( current < lowbound ) lowbound = current;
+	    if( current > highbound ) highbound = current;
+	}
+    }
+
+    for( i = 0; i < 1.0; i += 1.0 / ((float)div_y) ) {
+	for( j = 0; j < 1.0; j += 1.0 / ((float)div_x) ) {
+	    current = ((v->depth( j,i ) - lowbound) / 
+		       (highbound - lowbound)) * 8;
+	    putchar(depth_map_chars[(int)current]);
+	}
+	putchar('\n');
+    }
+}
+
+double volume::depth( double x, double y ) { return 0.0; }
diff --git a/Examples/ocaml/shapes/example.h b/Examples/ocaml/shapes/example.h
new file mode 100644
index 0000000..4b16444
--- /dev/null
+++ b/Examples/ocaml/shapes/example.h
@@ -0,0 +1,18 @@
+#ifndef EXAMPLE_H
+#define EXAMPLE_H
+
+class shape {
+public:
+  virtual ~shape();
+  virtual bool cover( double x, double y ); // does this shape cover this point?
+};
+
+class volume {
+public:
+    virtual double depth( double x, double y );
+};
+
+extern void draw_shape_coverage( shape *s, int div_x, int div_y );
+extern void draw_depth_map( volume *v, int div_x, int div_y );
+
+#endif//EXAMPLE_H
diff --git a/Examples/ocaml/shapes/example.i b/Examples/ocaml/shapes/example.i
new file mode 100644
index 0000000..ac0fa4a
--- /dev/null
+++ b/Examples/ocaml/shapes/example.i
@@ -0,0 +1,10 @@
+/* File : example.i */
+%module(directors="1") example
+#ifndef SWIGSEXP
+%{
+	#include "example.h"
+%}
+#endif
+
+%feature("director");
+%include "example.h"
diff --git a/Examples/ocaml/shapes/example_prog.ml b/Examples/ocaml/shapes/example_prog.ml
new file mode 100644
index 0000000..b9e3515
--- /dev/null
+++ b/Examples/ocaml/shapes/example_prog.ml
@@ -0,0 +1,76 @@
+(* example_prog.ml *)
+
+open Swig ;;
+open Example ;;
+
+let side_length (ax,ay) (bx,by) =
+  sqrt (((bx -. ax) ** 2.0) +. ((by -. ay) ** 2.0)) ;;
+
+let triangle_area a_pt b_pt c_pt =
+  let a = (side_length a_pt b_pt) 
+  and b = (side_length b_pt c_pt)
+  and c = (side_length c_pt a_pt) in
+  let s = (a +. b +. c) /. 2.0 in
+    sqrt (s *. (s -. a) *. (s -. b) *. (s -. c)) ;;
+
+let point_in_triangle (pta,ptb,ptc) x y =
+  let delta = 0.0000001 in (* Error *)
+  let ptx = (x,y) in
+    begin
+      let a_area = triangle_area pta ptb ptx
+      and b_area = triangle_area ptb ptc ptx
+      and c_area = triangle_area ptc pta ptx
+      and x_area = triangle_area pta ptb ptc in
+      let result = (abs_float (a_area +. b_area +. c_area -. x_area)) < delta
+      in
+	result
+    end ;;
+
+let triangle_class pts ob meth args =
+  match meth with
+      "cover" ->
+	(match args with
+	     C_list [ x_arg ; y_arg ] ->
+	       let xa = x_arg as float 
+	       and ya = y_arg as float in
+		 (point_in_triangle pts xa ya) to bool
+	   | _ -> raise (Failure "cover needs two double arguments."))
+    | _ -> (invoke ob) meth args ;;
+
+let dist (ax,ay) (bx,by) = 
+  let dx = ax -. bx and dy = ay -. by in
+    sqrt ((dx *. dx) +. (dy *. dy))
+
+let waveplot_depth events distance pt =
+  (List.fold_left (+.) 0.0 
+     (List.map 
+	(fun (x,y,d) -> 
+	   let t = dist pt (x,y) in
+	     ((sin t) /. t) *. d)
+	events)) +. distance
+
+let waveplot_class events distance ob meth args =
+  match meth with
+      "depth" ->
+	(match args with
+	     C_list [ x_arg ; y_arg ] ->
+	       let xa = x_arg as float 
+	       and ya = y_arg as float in
+		 (waveplot_depth events distance (xa,ya)) to float
+	   | _ -> raise (Failure "cover needs two double arguments."))
+    | _ -> (invoke ob) meth args ;;
+
+let triangle =
+  new_derived_object 
+    new_shape
+    (triangle_class ((0.0,0.0),(0.5,1.0),(1.0,0.6)))
+    '() ;;
+
+let waveplot = 
+  new_derived_object
+    new_volume
+    (waveplot_class [ 0.01,0.01,3.0 ; 1.01,-2.01,1.5 ] 5.0)
+    '() ;;
+
+let _ = _draw_shape_coverage '(triangle, 60, 20) ;;
+let _ = _draw_depth_map '(waveplot, 60, 20) ;;