diff options
author | Haibo Huang <hhb@google.com> | 2019-10-08 15:48:26 -0700 |
---|---|---|
committer | Haibo Huang <hhb@google.com> | 2019-11-14 22:14:23 +0000 |
commit | 80b4251e302efb18c145a4786249d695397ed42a (patch) | |
tree | 12b9dec2513f7caa92e7835bc17ab16ae5635df6 /Examples/ocaml/shapes/runme.ml | |
parent | 189852d8cdfd5863c52ec7aa73affd926c5a3f43 (diff) | |
parent | 1e36f51346d95f8b9848e682c2eb986e9cb9b4f4 (diff) | |
download | swig-80b4251e302efb18c145a4786249d695397ed42a.tar.gz |
Upgrade swig to 'rel-4.0.1'llvm-r383902b
Also run autogen.sh to generate configure files.
Exempt-From-Owner-Approval: add myself to owners
Change-Id: I391aa20428836ae74dab8c8427627ca4dbc8ecf4
Diffstat (limited to 'Examples/ocaml/shapes/runme.ml')
-rw-r--r-- | Examples/ocaml/shapes/runme.ml | 76 |
1 files changed, 76 insertions, 0 deletions
diff --git a/Examples/ocaml/shapes/runme.ml b/Examples/ocaml/shapes/runme.ml new file mode 100644 index 000000000..a7a2f9374 --- /dev/null +++ b/Examples/ocaml/shapes/runme.ml @@ -0,0 +1,76 @@ +(* runme.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) ;; |