#include #define USE_SURFACE_BTREE #include #include #include "GTS_inline.h" -- Bindings DSL file for the Gnu Triangulated Surface Library -- REMEMBER ForeignPtr for garbage collection! module Bindings.GTS where #strict_import import Bindings.GObject import Bindings.GLib.Fundamentals import Bindings.GLib.Fundamentals.BasicTypes #cinline GTS_CHECK_VERSION, -> -> -> IO #starttype GSList #field data, #field next, Ptr #stoptype #ccall g_slist_alloc, IO (Ptr ) #ccall g_slist_free, Ptr -> IO () #ccall g_slist_free_1, Ptr -> IO () #cinline g_slist_next, Ptr -> IO (Ptr ) #ccall g_slist_last, Ptr -> IO (Ptr ) #ccall g_slist_length, Ptr -> IO #ccall g_slist_nth, Ptr -> -> IO (Ptr ) #ccall g_slist_append, Ptr -> -> IO (Ptr ) #callback GtsObjectClassInitFunc, Ptr -> IO () #callback GtsObjectInitFunc, Ptr -> IO () #callback GtsArgSetFunc, Ptr -> IO () #callback GtsArgGetFunc, Ptr -> IO () #num GTS_CLASS_NAME_LENGTH #starttype GtsVector #stoptype #starttype GtsMatrix #stoptype #ccall gts_matrix_new, -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> IO (Ptr ) #ccall gts_matrix_assign,Ptr -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> -> IO (Ptr ) #ccall gts_matrix_destroy,Ptr -> IO () #ccall gts_matrix_zero,Ptr -> IO (Ptr ) #ccall gts_matrix_identity,Ptr -> IO (Ptr ) #ccall gts_matrix_transpose,Ptr -> IO (Ptr ) #ccall gts_matrix_inverse,Ptr -> IO (Ptr ) #ccall gts_matrix_product, Ptr -> Ptr -> IO (Ptr ) #ccall gts_matrix_scale, Ptr -> Ptr -> IO (Ptr ) #ccall gts_matrix_translate, Ptr -> Ptr -> IO (Ptr ) #ccall gts_matrix_rotate, Ptr -> Ptr -> -> IO (Ptr ) #starttype GtsColor #field r, #field g, #field b, #stoptype #callback GtsFunc, -> -> IO #starttype GtsFile #field line, #field pos, #field error,Ptr #stoptype #starttype GtsFileVariable #stoptype #ccall fopen,CString -> CString -> IO (Ptr CFile) #ccall fclose, Ptr CFile -> IO Int #ccall gts_file_new, Ptr CFile -> IO (Ptr ) #ccall gts_file_new_from_string, Ptr -> IO ( Ptr ) #ccall gts_file_getc, Ptr -> IO #ccall gts_file_destroy, IO (Ptr ) -- #cinline GTS_OBJECT_FLAGS, Ptr -> #starttype GtsObjectClassInfo #array_field name, #field object_size, #field class_size, #stoptype #starttype GtsObjectClass #field info, #field parent_class,Ptr #stoptype #starttype GtsObject #field klass, Ptr #field flags, #stoptype #starttype GtsPointClass #field parent_class, #field binary, #stoptype #starttype GtsPoint #field object, Ptr #field x, #field y, #field z, #stoptype #ccall gts_object_class, IO #ccall gts_object_class_new, Ptr -> Ptr -> IO #ccall gts_object_check_cast, -> -> IO #ccall gts_object_class_check_cast, -> -> IO -- #cinline gts_object_is_from_class, -> -> IO -- #cinline gts_object_class_is_from_class, -> -> IO #ccall gts_object_class_from_name,Ptr -> IO (Ptr ) #starttype GtsRange #field min, #field max, #field sum, #field sum2, #field mean, #field stddev, #field n, #stoptype #starttype GtsSegment #stoptype #starttype GtsTriangleClass #stoptype #starttype GtsTriangle #field e1, Ptr #field e2, Ptr #field e3, Ptr #stoptype #ccall gts_triangle_enclosing, Ptr -> Ptr -> -> IO (Ptr ) #ccall gts_triangle_class, IO (Ptr ) #ccall gts_triangle_new, Ptr -> Ptr -> Ptr -> Ptr -> IO (Ptr ) #ccall gts_triangle_set, Ptr -> Ptr -> Ptr -> Ptr -> IO () #ccall gts_triangle_area, Ptr -> IO #ccall gts_triangle_perimeter, Ptr -> IO #ccall gts_triangle_quality, Ptr -> IO #ccall gts_triangle_normal, Ptr -> Ptr -> Ptr -> Ptr -> IO () #ccall gts_triangle_revert, Ptr -> IO () #ccall gts_triangle_orientation, Ptr -> IO #ccall gts_triangle_neighbors, Ptr -> IO (Ptr ) #ccall gts_triangle_vertices_edges, Ptr -> Ptr -> Ptr (Ptr ) -> Ptr (Ptr ) -> Ptr (Ptr ) -> Ptr (Ptr ) -> Ptr (Ptr ) -> Ptr (Ptr ) -> IO () #ccall gts_triangle_vertices, Ptr -> Ptr -> Ptr (Ptr ) -> Ptr (Ptr ) -> Ptr (Ptr ) -> IO () #ccall gts_triangle_vertex_opposite, Ptr -> Ptr -> IO (Ptr -> Ptr -> IO (Ptr -> IO #ccall gts_triangle_circumcircle_center, Ptr -> Ptr -> IO (Ptr ) #ccall gts_triangle_interpolate_height, Ptr -> Ptr -> IO () #ccall gts_triangles_from_edges, Ptr -> IO (Ptr ) #starttype GtsVertex #field p, #stoptype #starttype GtsVertexClass #stoptype #ccall gts_range_init, Ptr -> IO () #ccall gts_range_reset,Ptr -> IO () #ccall gts_range_add_value,Ptr -> -> IO () #ccall gts_range_update,Ptr -> IO () #ccall gts_point_class, IO (Ptr ) #ccall gts_point_new, Ptr -> -> -> -> IO ( Ptr ) #ccall gts_point_set, Ptr -> -> -> -> IO () #cinline gts_point_is_in_rectangle, Ptr -> Ptr -> Ptr -> IO #ccall gts_vertex_class,IO (Ptr ) #ccall gts_vertex_new,Ptr -> -> -> -> IO (Ptr ) #starttype GtsVertexNormal #field n, #stoptype #ccall gts_vertex_normal_class,IO (Ptr ) #starttype GtsColorVertex #field c, #stoptype #ccall gts_color_vertex_class,IO (Ptr ) #starttype GtsSurface #field keep_faces, #stoptype #starttype GtsSurfaceClass #stoptype #starttype GtsEdgeClass #stoptype #starttype GtsEdge #field triangles,Ptr #field segment,Ptr #stoptype #starttype GtsFaceClass #stoptype #starttype GtsFace #stoptype #starttype GtsSurfaceStats #stoptype #starttype GtsSurfaceQualityStats #stoptype #ccall gts_face_class,IO (Ptr ) #ccall gts_edge_class,IO (Ptr ) #ccall gts_surface_class,IO (Ptr ) #ccall gts_surface_new,Ptr -> Ptr -> Ptr -> Ptr -> IO (Ptr ) #ccall gts_surface_add_face, Ptr -> Ptr -> IO () #ccall gts_surface_read, Ptr -> Ptr -> IO #ccall gts_surface_remove_face,Ptr -> Ptr -> IO () #ccall gts_surface_area, Ptr -> IO #ccall gts_surface_stats, Ptr -> Ptr -> IO () #ccall gts_surface_quality_stats, Ptr -> Ptr -> IO () #ccall gts_surface_foreach_vertex, Ptr -> -> -> IO () #ccall gts_surface_foreach_edge, Ptr -> -> -> IO () #ccall gts_surface_foreach_face, Ptr -> -> -> IO () #ccall gts_surface_foreach_face_remove, Ptr -> -> -> IO #ccall gts_surface_generate_sphere, Ptr -> -> IO ( Ptr ) #ccall gts_surface_copy, Ptr -> Ptr -> IO (Ptr ) #ccall gts_surface_merge, Ptr -> Ptr -> IO () #ccall gts_surface_is_manifold, Ptr -> IO #ccall gts_surface_is_closed, Ptr -> IO #ccall gts_surface_is_orientable, Ptr -> IO #ccall gts_surface_volume, Ptr -> IO #ccall gts_surface_center_of_mass, Ptr -> Ptr -> IO #ccall gts_surface_center_of_area, Ptr -> Ptr -> IO #ccall gts_surface_vertex_number, Ptr -> IO #ccall gts_surface_edge_number, Ptr -> IO #ccall gts_surface_face_number, Ptr -> IO #ccall gts_surface_boundary, Ptr -> IO (Ptr ) #ccall gts_surface_split, Ptr -> IO (Ptr ) #ccall gts_surface_write, Ptr -> Ptr CFile -> IO () #starttype GtsSurfaceInterClass #stoptype #starttype GtsSurfaceInter #field s1,Ptr #field s2,Ptr #stoptype #starttype GNode #stoptype #ccall gts_face_new, Ptr -> Ptr -> Ptr -> Ptr -> IO (Ptr ) #ccall gts_surface_inter_class,IO (Ptr ) #ccall gts_surface_inter_new, Ptr -> Ptr -> Ptr -> Ptr -> Ptr -> -> -> IO (Ptr ) #ccall gts_surface_inter_check, Ptr -> Ptr -> IO #ccall gts_surface_inter_boolean, Ptr -> Ptr -> -> IO () #ccall gts_surface_is_self_intersecting, Ptr -> IO (Ptr ) #ccall gts_surface_intersection, Ptr -> Ptr -> Ptr -> Ptr -> IO (Ptr ) #ccall gts_bb_tree_new, Ptr -> IO (Ptr ) #ccall gts_bb_tree_surface, Ptr -> IO (Ptr ) #ccall gts_bb_tree_destroy, Ptr -> -> IO () #ccall gts_bb_tree_stabbed, Ptr -> Ptr -> IO (Ptr ) #ccall gts_object_destroy, Ptr -> IO () -- #starttype GtsConstraintClass -- #stoptype -- #starttype GtsConstraint -- #stoptype #callback GtsEncroachFunc, Ptr -> Ptr -> Ptr -> -> IO #callback GtsKeyFunc, -> -> IO #ccall gts_constraint_class, IO (Ptr ) #ccall gts_point_locate, Ptr -> Ptr -> Ptr -> IO (Ptr ) #ccall gts_delaunay_add_constraint, Ptr -> Ptr -> IO (Ptr ) #ccall gts_delaunay_check, Ptr -> IO (Ptr ) #ccall gts_delaunay_remove_hull, Ptr -> IO () #ccall gts_delaunay_conform,Ptr -> -> FunPtr -> -> IO #ccall gts_delaunay_refine,Ptr -> -> FunPtr -> -> FunPtr -> -> IO #ccall gts_vertex_encroaches_edge,Ptr -> Ptr -> IO #ccall gts_edge_new, Ptr -> Ptr -> Ptr -> IO (Ptr ) #ccall gts_edge_replace, Ptr -> Ptr -> IO () #ccall gts_edge_swap, Ptr -> Ptr -> IO () #ccall gts_segment_triangle_intersection, Ptr -> Ptr -> -> IO (Ptr ) #ccall gts_point_in_triangle_circle,Ptr -> Ptr -> IO #ccall gts_point_orientation, Ptr -> Ptr -> Ptr -> IO #ccall gts_point_is_inside_surface, Ptr -> Ptr -> -> IO #ccall gts_point_in_circle, Ptr -> Ptr -> Ptr -> Ptr -> IO #ccall gts_point_orientation_3d, Ptr -> Ptr -> Ptr -> Ptr -> Ptr -> IO #starttype GtsBBoxClass #stoptype #ccall gts_bbox_class, IO (Ptr ) #starttype GtsBBox #field x1, #field y1, #field z1, #field x2, #field y2, #field z2, #field bounded, #stoptype #ccall gts_surface_strip, Ptr -> IO (Ptr ) #ccall gts_surface_distance, Ptr -> Ptr -> -> Ptr -> Ptr -> IO () #ccall gts_bbox_surface, Ptr -> Ptr -> IO ( Ptr ) #ccall gts_bboxes_are_overlapping, Ptr -> Ptr -> IO #ccall gts_delaunay_add_vertex, Ptr -> Ptr -> Ptr -> IO (Ptr ) #ccall gts_delaunay_add_vertex_to_face, Ptr -> Ptr -> Ptr -> IO (Ptr ) -- Typed helper functions #ccall gts_surface_destroy, Ptr -> IO () #ccall gts_triangle_destroy, Ptr -> IO () #ccall gts_vertex_destory, Ptr -> IO ()