;;
;; Bindings for the Gnu Triangulated Surface Library
;;
;; Based on the Haskell and Python GTS bindings.
;;
;; Copyright 2011 Ivan Raikov and the Okinawa Institute of Science and Technology.
;;
;; This program 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 3 of the
;; License, or (at your option) any later version.
;;
;; This program 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.
;;
;; A full copy of the GPL license can be found at
;; <http://www.gnu.org/licenses/>.

#>

#define USE_SURFACE_BTREE
#include <stdio.h>
#include <gts.h>

<#

(define-foreign-type FILE "FILE")

;;  (compose list->string vector->list)
;;  (compose list->vector string->list) )

(define-foreign-type GtsObjectClass "GtsObjectClass")
(define-foreign-type GtsObject "GtsObject")
(define-foreign-type GtsMatrix "GtsMatrix")

;; Type for an (r,g,b) triple in GTS (floating point)
(define-foreign-type GtsColor "GtsColor")

;; GTS formatted data file
(define-foreign-type GtsFile "GtsFile")

;; A GTS formatted data file variable
(define-foreign-type GtsFileVariable "GtsFileVariable")


(define-foreign-type GtsObjectClassInfo "GtsObjectClassInfo")

(define-foreign-type GtsObjectClass "GtsObjectClass")

(define-foreign-type GtsObject "GtsObject")

(define-foreign-type GtsPointClass "GtsPointClass")

(define-foreign-type GtsPoint "GtsPoint")

(define-foreign-type GtsRange "GtsRange")

(define-foreign-type GtsSegment "GtsSegment")

(define-foreign-type GtsTriangleClass "GtsTriangleClass")

(define-foreign-type GtsTriangle "GtsTriangle")

(define-foreign-type GtsVertex "GtsVertex")

(define-foreign-type GtsVertexClass "GtsVertexClass")

(define-foreign-type GtsVertexNormal "GtsVertexNormal")

(define-foreign-type GtsColorVertex "GtsColorVertex")

(define-foreign-type GtsSurface "GtsSurface")

(define-foreign-type GtsSurfaceClass "GtsSurfaceClass")

(define-foreign-type GtsEdgeClass "GtsEdgeClass")

(define-foreign-type GtsEdge "GtsEdge")

(define-foreign-type GtsFaceClass "GtsFaceClass")

(define-foreign-type GtsFace "GtsFace")

(define-foreign-type GtsSurfaceStats "GtsSurfaceStats")

(define-foreign-type GtsSurfaceQualityStats "GtsSurfaceQualityStats")

(define-foreign-type GtsSurfaceInterClass "GtsSurfaceInterClass")

(define-foreign-type GtsSurfaceInter "GtsSurfaceInter")

(define-foreign-type GtsSurfaceTraverse "GtsSurfaceTraverse")

(define-foreign-type GtsConstraintClass "GtsConstraintClass")

(define-foreign-type GtsConstraint "GtsConstraint")

(define-foreign-type GtsBBoxClass "GtsBBoxClass")

(define-foreign-type GtsBBox "GtsBBox")

(define-foreign-type GtsBBoxClass "GtsBBoxClass")

;; callback types
(define-foreign-type GtsFunc         "GtsFunc")
(define-foreign-type GtsEncroachFunc "GtsEncroachFunc")
(define-foreign-type GtsKeyFunc      "GtsKeyFunc")
(define-foreign-type GtsRefineFunc   "GtsRefineFunc")
(define-foreign-type GtsStopFunc     "GtsStopFunc")

(define check-version 
  (foreign-lambda bool "GTS_CHECK_VERSION" unsigned-int unsigned-int unsigned-int))

(define class-name-length (foreign-value "GTS_CLASS_NAME_LENGTH" unsigned-int))

(define-foreign-variable allow-floating-vertices
  bool "gts_allow_floating_vertices" )


;; Create a new GTS Matrix 4x4 object and return the pointer to it.
(define matrix-new
  (foreign-lambda (nonnull-c-pointer GtsMatrix)  "gts_matrix_new" 
		  double double double double double double double double double 
		  double double double double double double double))

;; Set the fields of an existing GTS Matrix object
(define matrix-assign
  (foreign-lambda void  "gts_matrix_assign" 
		  (nonnull-c-pointer GtsMatrix)  
		  double double double double double double double double 
		  double double double double double double double double))

;; Destroy a GTS matrix and free the associated memory
(define matrix-destroy
  (foreign-lambda void  "gts_matrix_destroy" (nonnull-c-pointer GtsMatrix)))

;; Set a GTS matrix to the Zero matrix (if the matrix is NULL a new one is allocated)
(define matrix-zero
  (foreign-lambda (nonnull-c-pointer GtsMatrix)  "gts_matrix_zero" (c-pointer GtsMatrix)))

;; Set a GTS matrix to the Identity matrix (if the matrix is NULL a new one is allocated)
(define matrix-identity
  (foreign-lambda (nonnull-c-pointer GtsMatrix)  "gts_matrix_identity" (c-pointer GtsMatrix)))

;; Transpose a GTS Matrix and return the newly allocated matrix
(define matrix-transpose
  (foreign-lambda (nonnull-c-pointer GtsMatrix)  "gts_matrix_transpose" (nonnull-c-pointer GtsMatrix)))

;; Invert a GTS Matrix and return the newly allocated matrix or NULL if the matrix can't be inverted
(define matrix-inverse
  (foreign-lambda (c-pointer GtsMatrix)  "gts_matrix_inverse" (nonnull-c-pointer GtsMatrix)))

;; Calculate the product of two matrices and return the newly allocated matrix
(define matrix-product
  (foreign-lambda (nonnull-c-pointer GtsMatrix)  "gts_matrix_product" (nonnull-c-pointer GtsMatrix) (nonnull-c-pointer GtsMatrix)))

;; Scale a GTS Matrix in place
(define matrix-scale
  (foreign-lambda (nonnull-c-pointer GtsMatrix)  "gts_matrix_scale" (c-pointer GtsMatrix) f64vector))

;; Translate the GTS Matrix by the GTS Vector (if the Matrix is NULL a new one is allocated and translated)
(define matrix-translate
  (foreign-lambda (nonnull-c-pointer GtsMatrix)  "gts_matrix_translate" (c-pointer GtsMatrix) f64vector))

;; Rotate the GTS Matrix around the vector by the given angle (if the Matrix is NULL a new one is allocated and translated)
(define matrix-rotate
  (foreign-lambda (nonnull-c-pointer GtsMatrix)  "gts_matrix_rotate" (c-pointer GtsMatrix) f64vector double))


;; Open a file
(define fopen 
  (foreign-lambda (c-pointer FILE) "fopen" c-string c-string))

;; Close a file
(define fclose 
  (foreign-lambda int "fclose" (nonnull-c-pointer FILE)))

;; File pointer to stderr
(define stderr (foreign-value  "stderr" (c-pointer FILE)))

;; Create a new GTS file handle from a file
(define file-new
  (foreign-lambda (nonnull-c-pointer GtsFile) "gts_file_new" (nonnull-c-pointer FILE)))

;; Create a new GTS file handle from a C String. 
(define file-new-from-string
  (foreign-lambda (nonnull-c-pointer GtsFile) "gts_file_new_from_string" c-string))

;; Destroy a GTS file handle and free the memory
(define file-destroy
  (foreign-lambda void  "gts_file_destroy" (nonnull-c-pointer GtsFile)))

(define object-class
  (foreign-lambda nonnull-c-pointer "gts_object_class" ))

(define object-class-new 
  (foreign-lambda nonnull-c-pointer "gts_object_class_new"  
		  (nonnull-c-pointer GtsObjectClass) 
		  (nonnull-c-pointer GtsObjectClassInfo) ))

(define object-check-cast 
  (foreign-lambda nonnull-c-pointer "gts_object_check_cast"  
		  nonnull-c-pointer nonnull-c-pointer ))

(define object-class-check-cast 
  (foreign-lambda nonnull-c-pointer "gts_object_class_check_cast"  
		  nonnull-c-pointer nonnull-c-pointer ))

(define object-class-from-name 
  (foreign-lambda (nonnull-c-pointer GtsObjectClass) "gts_object_class_from_name"  c-string ))


;; Create a triangle which is guaranteed to enclose all the points in the list
(define triangle-enclosing 
  (foreign-lambda (nonnull-c-pointer GtsTriangle) "gts_triangle_enclosing"  
		  (nonnull-c-pointer GtsTriangleClass)
		  (nonnull-c-pointer g_slist) 
		  double ))

;; Get the class descriptor for the GTS Triangle class
(define default-triangle-class
  (foreign-lambda (nonnull-c-pointer GtsTriangleClass) "gts_triangle_class" ))

;; Create a new triangle from 3 edges
(define gts_triangle_new 
  (foreign-lambda  (nonnull-c-pointer GtsTriangle)  "gts_triangle_new"  
		   (nonnull-c-pointer GtsTriangleClass)  
		   (nonnull-c-pointer GtsEdge)
		   (nonnull-c-pointer GtsEdge)
		   (nonnull-c-pointer GtsEdge) ))


(define (triangle-new e1 e2 e3 #!key (triangle-class (default-triangle-class)))
  (gts_triangle_new triangle-class e1 e2 e3))

  
;; Discard the existing edges of the triangle and replace with the new ones
(define triangle-set 
  (foreign-lambda  void  "gts_triangle_set"  
		   (nonnull-c-pointer GtsTriangle)  
		   (nonnull-c-pointer GtsEdge)
		   (nonnull-c-pointer GtsEdge)
		   (nonnull-c-pointer GtsEdge) ))

;; Get the area of this triangle
(define triangle-area 
  (foreign-lambda  double  "gts_triangle_area"  (nonnull-c-pointer GtsTriangle)))

;; Get the perimeter of this triangle
(define triangle-perimeter 
  (foreign-lambda  double  "gts_triangle_perimeter"  (nonnull-c-pointer GtsTriangle)))

;; Get a measure of the quality of this triangle (how close to equilateral it is?)
(define triangle-quality 
  (foreign-lambda  double  "gts_triangle_quality"  (nonnull-c-pointer GtsTriangle)))

;; Get the normal to the plane of this triangle
(define gts_triangle_normal 
  (foreign-lambda void "gts_triangle_normal" (nonnull-c-pointer GtsTriangle) f64vector f64vector f64vector))

(define (triangle-normal t)
  (let ((x (make-f64vector 1))
	(y (make-f64vector 1))
	(z (make-f64vector 1)))
    (gts_triangle_normal t x y z)
    (f64vector (f64vector-ref x 0) (f64vector-ref y 0) (f64vector-ref z 0))))

;; Change the orientation of triangle t, turning it inside out
(define triangle-revert 
  (foreign-lambda  void  "gts_triangle_revert"  (nonnull-c-pointer GtsTriangle)))

(define triangle-orientation 
  (foreign-lambda  double  "gts_triangle_orientation"  (nonnull-c-pointer GtsTriangle)))

(define triangle-neighbors 
  (foreign-lambda  (nonnull-c-pointer g_slist)  "gts_triangle_neighbors"  (nonnull-c-pointer GtsTriangle)))

(define gts_triangle_vertices_edges 
  (foreign-lambda  void "gts_triangle_vertices_edges"  
		   (nonnull-c-pointer GtsTriangle)
		   (c-pointer GtsEdge)
		   (nonnull-c-pointer (c-pointer GtsVertex))
		   (nonnull-c-pointer (c-pointer GtsVertex))
		   (nonnull-c-pointer (c-pointer GtsVertex))
		   (nonnull-c-pointer (c-pointer GtsEdge))
		   (nonnull-c-pointer (c-pointer GtsEdge))
		   (nonnull-c-pointer (c-pointer GtsEdge))
		   ))

(define (triangle-vertices-edges t e)
  (let-location ((v1 (c-pointer GtsVertex))
		 (v2 (c-pointer GtsVertex))
		 (v3 (c-pointer GtsVertex))
		 (e1 (c-pointer GtsEdge))
		 (e2 (c-pointer GtsEdge))
		 (e3 (c-pointer GtsEdge)))
      (gts_triangle_vertices_edges t e 
        (location v1) (location v2) (location v3)
        (location e1) (location e2) (location e3))
      (list (vector v1 v2 v3)
	    (vector e1 e2 e3))))

(define gts_triangle_vertices 
  (foreign-lambda  void "gts_triangle_vertices"  
		   (nonnull-c-pointer GtsTriangle)
		   (nonnull-c-pointer (c-pointer GtsVertex))
		   (nonnull-c-pointer (c-pointer GtsVertex))
		   (nonnull-c-pointer (c-pointer GtsVertex))
		   ))

(define (triangle-vertices t e)
  (let-location ((v1 (c-pointer GtsVertex))
		 (v2 (c-pointer GtsVertex))
		 (v3 (c-pointer GtsVertex)))
      (gts_triangle_vertices t e 
        (location v1) (location v2) (location v3))
      (vector v1 v2 v3)))

(define triangle-vertex-opposite 
  (foreign-lambda  (nonnull-c-pointer GtsVertex) "gts_triangle_vertex_opposite"  
		   (nonnull-c-pointer GtsTriangle)
		   (nonnull-c-pointer GtsEdge)))

(define triangle-edge-opposite 
  (foreign-lambda  (nonnull-c-pointer GtsEdge) "gts_triangle_edge_opposite"  
		   (nonnull-c-pointer GtsTriangle)
		   (nonnull-c-pointer GtsVertex)))

(define triangle-is-ok 
  (foreign-lambda  bool "gts_triangle_is_ok"  
		   (nonnull-c-pointer GtsTriangle)))

(define triangle-circumcircle-center
  (foreign-lambda  (nonnull-c-pointer GtsPoint) "gts_triangle_circumcircle_center"  
		   (nonnull-c-pointer GtsTriangle)
		   (nonnull-c-pointer GtsPointClass)))

(define triangle-interpolate-height
  (foreign-lambda  void "gts_triangle_interpolate_height"  
		   (nonnull-c-pointer GtsTriangle)
		   (nonnull-c-pointer GtsPoint)))

(define triangles-from-edges
  (foreign-lambda  (nonnull-c-pointer g_slist) "gts_triangles_from_edges"  
		   (nonnull-c-pointer g_slist)))



;; Clear a range
(define range-init
  (foreign-lambda void "gts_range_init" (nonnull-c-pointer GtsRange)))
(define range-reset
  (foreign-lambda void "gts_range_reset" (nonnull-c-pointer GtsRange)))
(define range-add-value
  (foreign-lambda void "gts_range_add_value" (nonnull-c-pointer GtsRange) double))
(define range-add-update
  (foreign-lambda void "gts_range_update" (nonnull-c-pointer GtsRange)))

;; Get class descriptor for the GTS point class
(define default-point-class
  (foreign-lambda (nonnull-c-pointer GtsPointClass) "gts_point_class" ))

;; Create a new GTS point in 3d space
(define gts_point_new
  (foreign-lambda (nonnull-c-pointer GtsPoint)  "gts_point_new" 
		  (nonnull-c-pointer GtsPointClass) 
		  double double double))

(define (point-new x y z #!key (point-class (default-point-class)))
  (gts_point_new point-class x y z))


;; Set the value of a GTS point in 3d space
(define point-set
  (foreign-lambda void  "gts_point_set" 
		  (nonnull-c-pointer GtsPoint) 
		  double double double))

;; True iff the point is within or on the boundary of the box defined by the two other points
(define point-is-in-rectangle
  (foreign-lambda bool  "gts_point_is_in_rectangle" 
		  (nonnull-c-pointer GtsPoint) 
		  (nonnull-c-pointer GtsPoint) 
		  (nonnull-c-pointer GtsPoint) ))

;; Transform the coordinates of p according to m.
(define point-transform 
  (foreign-lambda void "gts_point_transform"
		  (nonnull-c-pointer GtsPoint)
		  (nonnull-c-pointer GtsMatrix)))

;; Get class descriptor for the GTS vertex class
(define default-vertex-class
  (foreign-lambda (nonnull-c-pointer GtsVertexClass) "gts_vertex_class" ))

;; Create a new GTS vertex in 3d space
(define gts_vertex_new
  (foreign-lambda (nonnull-c-pointer GtsVertex)  "gts_vertex_new" 
		  (nonnull-c-pointer GtsVertexClass) 
		  double double double))

(define (vertex-new x y z #!key (vertex-class (default-vertex-class)))
  (gts_vertex_new vertex-class x y z))

;; True if this vertex is not part of a GTS segment
(define vertex-is-unattached
  (foreign-lambda bool  "gts_vertex_is_unattached" 
		  (nonnull-c-pointer GtsVertex) ))

;; Return the number of connected triangles sharing the vertex, if
;; second parameter is true then sever the connection
(define vertex-is-contact
  (foreign-lambda unsigned-int  "gts_vertex_is_contact" 
		  (nonnull-c-pointer GtsVertex) 
		  bool))

;; Null unless two vertices are the endpoints of the same segment, in
;; which case return the segment

(define vertices-are-connected
  (foreign-lambda (c-pointer GtsSegment)  "gts_vertices_are_connected" 
		  (nonnull-c-pointer GtsVertex) 
		  (nonnull-c-pointer GtsVertex) ))

;; Replace a vertex with another vertex and update all objects using it
(define vertex-replace
  (foreign-lambda void  "gts_vertex_replace" 
		  (nonnull-c-pointer GtsVertex) 
		  (nonnull-c-pointer GtsVertex) ))

;; Adds to list all the GtsVertex connected to v by a GtsSegment and
;; not already in list. If surface is not NULL only the vertices
;; connected to v by an edge belonging to surface are considered.
(define vertex-neighbors
  (foreign-lambda (nonnull-c-pointer g_slist)   "gts_vertex_neighbors" 
		  (nonnull-c-pointer GtsVertex) 
		  (nonnull-c-pointer g_slist) 
		  (c-pointer GtsSurface) ))

;; Adds all the GtsTriangle which share v as a vertex and do not
;; already belong to list.
(define vertex-triangles
  (foreign-lambda (nonnull-c-pointer g_slist)   "gts_vertex_triangles" 
		  (nonnull-c-pointer GtsVertex) 
		  (nonnull-c-pointer g_slist) ))

;; Adds all the GtsFace belonging to surface (if not NULL) which share
;; v as a vertex and do not already belong to list.
(define vertex-faces
  (foreign-lambda (nonnull-c-pointer g_slist)   "gts_vertex_faces" 
		  (nonnull-c-pointer GtsVertex) 
		  (nonnull-c-pointer GtsSurface) 
		  (nonnull-c-pointer g_slist) ))

;; A list of GtsEdge describing in counterclockwise order the boundary
;; of the fan of summit v, the faces of the fan belonging to surface
(define vertex-fan-oriented
  (foreign-lambda (nonnull-c-pointer g_slist)   "gts_vertex_fan_oriented" 
		  (nonnull-c-pointer GtsVertex) 
		  (nonnull-c-pointer GtsSurface) ))

;; TRUE if v is strictly contained in the diametral circle of e, FALSE otherwise
(define vertex-enroaches-edge
  (foreign-lambda bool   "gts_vertex_encroaches_edge" 
		  (nonnull-c-pointer GtsVertex) 
		  (nonnull-c-pointer GtsEdge) ))

;; For each vertex v in vertices look if there are any vertex of
;; vertices contained in a box centered on v of size 2*epsilon. If
;; there are and if check is not NULL and returns TRUE, replace them
;; with v (using gts_vertex_replace()), destroy them and remove them
;; from list. This is done efficiently using Kd-Trees.
(define vertices-merge
  (foreign-lambda (nonnull-c-pointer g_list)   "gts_vertices_merge" 
		  (nonnull-c-pointer g_list)
		  double
		  c-pointer))

(define default-vertex-class
  (foreign-lambda (nonnull-c-pointer GtsVertexClass) "gts_vertex_class" ))

(define default-face-class
  (foreign-lambda (nonnull-c-pointer GtsFaceClass) "gts_face_class" ))

(define default-edge-class
  (foreign-lambda (nonnull-c-pointer GtsEdgeClass) "gts_edge_class" ))

(define default-surface-class
  (foreign-lambda (nonnull-c-pointer GtsSurfaceClass) "gts_surface_class" ))

(define default-vertex-normal-class
  (foreign-lambda (nonnull-c-pointer GtsVertexClass) "gts_vertex_normal_class" ))

(define default-color-vertex-class
  (foreign-lambda (nonnull-c-pointer GtsVertexClass) "gts_color_vertex_class" ))

;; Create a new empty surface which uses the specified types of sub-object
(define gts_surface_new
  (foreign-lambda (nonnull-c-pointer GtsSurface)  "gts_surface_new" 
		  (nonnull-c-pointer GtsSurfaceClass) 
		  (nonnull-c-pointer GtsFaceClass) 
		  (nonnull-c-pointer GtsEdgeClass) 
		  (nonnull-c-pointer GtsVertexClass) ))

(define (surface-new #!key 
		     (surface-class (default-surface-class))
		     (face-class    (default-face-class))
		     (edge-class    (default-edge-class))
		     (vertex-class  (default-vertex-class)))
  (gts_surface_new surface-class face-class edge-class vertex-class))

;; Add a face to a surface
(define surface-add-face
  (foreign-lambda void  "gts_surface_add_face" 
		  (nonnull-c-pointer GtsSurface) 
		  (nonnull-c-pointer GtsFace) ))

;; Read a surface from a GTS formatted file
(define surface-read
  (foreign-lambda unsigned-int  "gts_surface_read" 
		  (nonnull-c-pointer GtsSurface) 
		  (nonnull-c-pointer GtsFile) ))

;; Remove a face from a surface
(define surface-remove-face
  (foreign-lambda void  "gts_surface_remove_face" 
		  (nonnull-c-pointer GtsSurface) 
		  (nonnull-c-pointer GtsFace) ))

;; Get the surface area of all triangles in the surface
(define surface-area
  (foreign-lambda double  "gts_surface_area" 
		  (nonnull-c-pointer GtsSurface) ))


;; Print some statistics on the surface
(define gts_print_surface_stats
  (foreign-lambda void  "gts_surface_print_stats" 
		  (nonnull-c-pointer GtsSurface)
		  (nonnull-c-pointer FILE)))

(define (print-surface-stats s)
  (gts_print_surface_stats s stderr))

;; Get some statistics on the quality of the triangles making up the surface
;; FIXME: instead of void this should return GtsSurfaceQualityStats
(define gts_surface_quality_stats
  (foreign-lambda void  "gts_surface_quality_stats" 
		  (nonnull-c-pointer GtsSurface)
		  (nonnull-c-pointer GtsSurfaceQualityStats)))

;; Invoke a function for each vertex in the surface
(define surface-foreach-vertex
  (foreign-lambda void "gts_surface_foreach_vertex"
		  (nonnull-c-pointer GtsSurface)
		  nonnull-c-pointer ;; GtsFunc
		  scheme-object))

;; Invoke a function for each edge in the surface
(define surface-foreach-edge
  (foreign-lambda void "gts_surface_foreach_edge"
		  (nonnull-c-pointer GtsSurface)
		  nonnull-c-pointer ;; GtsFunc
		  scheme-object))
		  
;; Invoke a function for each face in the surface
(define surface-foreach-face
  (foreign-lambda void "gts_surface_foreach_face"
		  (nonnull-c-pointer GtsSurface)
		  nonnull-c-pointer ;; GtsFunc
		  scheme-object))
		  
;; Invoke a function for each face in the surface and remove the face afterwards
(define gts-surface-foreach-face-remove
  (foreign-lambda void "gts_surface_foreach_face_remove"
		  (nonnull-c-pointer GtsSurface)
		  nonnull-c-pointer ;; GtsFunc
		  scheme-object))
		  
;; Generate a surface which is a tesselated model of a sphere
(define surface-generate-sphere
  (foreign-lambda (nonnull-c-pointer GtsSurface) "gts_surface_generate_sphere"
		  (nonnull-c-pointer GtsSurface)
		  unsigned-int))
		  

;; Add a copy of all the faces, edges and vertices of s2 to s1.
(define surface-copy
  (foreign-lambda (nonnull-c-pointer GtsSurface) "gts_surface_copy"
		  (nonnull-c-pointer GtsSurface)
		  (nonnull-c-pointer GtsSurface)))
		  

;; Adds all the faces of with which do not already belong to s to s.
(define surface-merge
  (foreign-lambda void "gts_surface_merge"
		  (nonnull-c-pointer GtsSurface)
		  (nonnull-c-pointer GtsSurface)))


;; True iff the surface describes a manifold
(define surface-is-manifold
  (foreign-lambda bool "gts_surface_is_manifold"
		  (nonnull-c-pointer GtsSurface)))

;; True iff the surface is closed
(define surface-is-closed
  (foreign-lambda bool "gts_surface_is_closed"
		  (nonnull-c-pointer GtsSurface)))

;; True iff all the faces of the surface have a compatible orientation
(define surface-is-orientable
  (foreign-lambda bool "gts_surface_is_orientable"
		  (nonnull-c-pointer GtsSurface)))

;; Return the volume of the domain bounded by the surface, only valid
;; if the surface is closed and orientable
(define surface-volume
  (foreign-lambda double "gts_surface_volume"
		  (nonnull-c-pointer GtsSurface)))

;; Return the center of mass of the domain bounded by the surface s,
;; only valid if the surface is closed and orientable
(define gts_surface_center_of_mass
  (foreign-lambda double "gts_surface_center_of_mass"
		  (nonnull-c-pointer GtsSurface)
		  (nonnull-c-pointer double)))

(define (surface-center-of-mass s)
  (let ((d (make-f64vector 3)))
    (list (gts_surface_center_of_mass s d) d)))


;; Return the center of area of the surface (all faces should be co-planar)
(define gts_surface_center_of_area
  (foreign-lambda double "gts_surface_center_of_area"
		  (nonnull-c-pointer GtsSurface)
		  (nonnull-c-pointer double))) 

(define (surface-center-of-area s)
  (let ((d (make-f64vector 3)))
    (list (gts_surface_center_of_area s d) d)))


(define surface-vertex-number
  (foreign-lambda unsigned-int "gts_surface_vertex_number"
		  (nonnull-c-pointer GtsSurface)))


(define surface-edge-number
  (foreign-lambda unsigned-int "gts_surface_edge_number"
		  (nonnull-c-pointer GtsSurface)))


(define surface-face-number
  (foreign-lambda unsigned-int "gts_surface_face_number"
		  (nonnull-c-pointer GtsSurface)))


(define surface-boundary
  (foreign-lambda (nonnull-c-pointer g_slist) "gts_surface_boundary"
		  (nonnull-c-pointer GtsSurface)))


(define surface-split
  (foreign-lambda (nonnull-c-pointer g_slist) "gts_surface_split"
		  (nonnull-c-pointer GtsSurface)))


(define surface-write
  (foreign-lambda void "gts_surface_write"
		  (nonnull-c-pointer GtsSurface)
		  (nonnull-c-pointer FILE )))


;; Create a new GTS Face from the 3 edges
(define gts_face_new 
  (foreign-lambda (nonnull-c-pointer GtsFace) "gts_face_new"
		  (nonnull-c-pointer GtsFaceClass)
		  (nonnull-c-pointer GtsEdge)
		  (nonnull-c-pointer GtsEdge)
		  (nonnull-c-pointer GtsEdge)))

(define (face-new e1 e2 e3 #!key (face-class (default-face-class)))
  (gts_face_new face-class e1 e2 e3))

;; Check if the face compatible with all its neighbors belonging to the surface
(define face-is-compatible 
  (foreign-lambda bool "gts_face_is_compatible"
		  (nonnull-c-pointer GtsFace)
		  (nonnull-c-pointer GtsSurface)))


;; Get the class for a surface intersection
(define surface-inter-class
  (foreign-lambda (nonnull-c-pointer GtsSurfaceInterClass) "gts_surface_inter_class"))

  
;; Create a new surface intersection from the two surfaces and the precomputed face bounding box trees
(define surface-inter-new
  (foreign-lambda (nonnull-c-pointer GtsSurfaceInter) "gts_surface_inter_new"
		  (nonnull-c-pointer GtsSurfaceInterClass)
		  (nonnull-c-pointer GtsSurface)
		  (nonnull-c-pointer GtsSurface)
		  (nonnull-c-pointer g_node)
		  (nonnull-c-pointer g_node)
		  bool bool))


;; True iff the edges in the intersection form a closed curve
(define gts_surface_inter_check
  (foreign-lambda bool "gts_surface_inter_check"
		  (nonnull-c-pointer GtsSurfaceInter)
		  s32vector))
  

(define (surface-inter-check s)
  (let ((closed (s32vector 0)))
    (gts_surface_inter_check s closed)
    (positive? (s32vector-ref closed 0) )))
    

;; Adds to surface the part of the surface described by si and op.
(define surface-inter-boolean
  (foreign-lambda void "gts_surface_inter_boolean"
		  (nonnull-c-pointer GtsSurfaceInter)
		  (nonnull-c-pointer GtsSurface)
		  unsigned-int))
  

;; A new GtsSurface containing the faces of s which are self-intersecting or NULL if no faces of s are self-intersecting.
(define surface-is-self-intersecting
  (foreign-lambda (c-pointer GtsSurface) "gts_surface_is_self_intersecting"
		  (nonnull-c-pointer GtsSurface)))

#>

void isosurface_function (gdouble **a, GtsCartesianGrid g, guint k, gpointer data)
{
   double x, y, z, v; unsigned int i,j;
   C_word f, res, sx, sy, sz; C_word *ptr;


   z = g.z;
   f = (C_word)data;

   for (i = 0, x = g.x; i < g.nx; i++, x += g.dx)
   {
     for (j = 0, y = g.y; j < g.ny; j++, y += g.dy)
     {
       ptr  = C_alloc (C_SIZEOF_FLONUM);
       sx   = C_flonum(&ptr, x);
       C_save (sx);
       ptr  = C_alloc (C_SIZEOF_FLONUM);
       sy   = C_flonum(&ptr, y);
       C_save (sy);
       ptr  = C_alloc (C_SIZEOF_FLONUM);
       sz   = C_flonum(&ptr, z);
       C_save (sz);

       res = C_callback (f, 3);

       if (C_truep (C_i_numberp(res)) )
       {
         v = C_c_double(res);
         a[i][j] = v;
       }
     }
  }
}

<#


(define isosurface-cartesian
  (foreign-safe-lambda* (nonnull-c-pointer GtsSurface)
			(((nonnull-c-pointer GtsSurface) s)
			 (double iso)
			 (unsigned-int nx) (unsigned-int ny) (unsigned-int nz)
			 (double dx) (double dy) (double dz)
			 (double x) (double y) (double z)
			 (scheme-object f))
#<<EOF
GtsCartesianGrid g;
g.x = x; g.y = y; g.z = z;
g.nx = nx; g.ny = ny; g.nz = nz;
g.dx = dx; g.dy = dy; g.dz = dz;

gts_isosurface_cartesian(s, g, &isosurface_function, (gpointer)f, iso);

C_return(s);
EOF
))


(define isosurface-tetra
  (foreign-safe-lambda* (nonnull-c-pointer GtsSurface)
			(((nonnull-c-pointer GtsSurface) s)
			 (double iso)
			 (unsigned-int nx) (unsigned-int ny) (unsigned-int nz)
			 (double dx) (double dy) (double dz)
			 (double x) (double y) (double z)
			 (scheme-object f))
#<<EOF
GtsCartesianGrid g;
g.x = x; g.y = y; g.z = z;
g.nx = nx; g.ny = ny; g.nz = nz;
g.dx = dx; g.dy = dy; g.dz = dz;

gts_isosurface_tetra(s, g, &isosurface_function, (gpointer)f, iso);

C_return(s);
EOF
))


(define isosurface-tetra-bounded
  (foreign-safe-lambda* (nonnull-c-pointer GtsSurface)
			(((nonnull-c-pointer GtsSurface) s)
			 (double iso)
			 (unsigned-int nx) (unsigned-int ny) (unsigned-int nz)
			 (double dx) (double dy) (double dz)
			 (double x) (double y) (double z)
			 (scheme-object f))
#<<EOF
GtsCartesianGrid g;
g.x = x; g.y = y; g.z = z;
g.nx = nx; g.ny = ny; g.nz = nz;
g.dx = dx; g.dy = dy; g.dz = dz;

gts_isosurface_tetra_bounded(s, g, &isosurface_function, (gpointer)f, iso);

C_return(s);
EOF
))


(define isosurface-tetra-bcl
  (foreign-safe-lambda* (nonnull-c-pointer GtsSurface)
			(((nonnull-c-pointer GtsSurface) s)
			 (double iso)
			 (unsigned-int nx) (unsigned-int ny) (unsigned-int nz)
			 (double dx) (double dy) (double dz)
			 (double x) (double y) (double z)
			 (scheme-object f))
#<<EOF
GtsCartesianGrid g;
g.x = x; g.y = y; g.z = z;
g.nx = nx; g.ny = ny; g.nz = nz;
g.dx = dx; g.dy = dy; g.dz = dz;

gts_isosurface_tetra_bcl(s, g, &isosurface_function, (gpointer)f, iso);

C_return(s);
EOF
))


;; Builds a new hierarchy of bounding boxes for the given list of bboxes.
(define bb-tree-new
  (foreign-lambda (nonnull-c-pointer g_node) "gts_bb_tree_new"
		  (nonnull-c-pointer g_slist) ))


;; A new hierarchy of bounding boxes bounding the faces of the given surface.
(define bb-tree-surface
  (foreign-lambda (nonnull-c-pointer g_node) "gts_bb_tree_surface"
		  (nonnull-c-pointer GtsSurface) ))


(define bb-tree-destroy
  (foreign-lambda void "gts_bb_tree_destroy"
		  (nonnull-c-pointer g_node)
		  bool))


;; TRUE if the ray starting at p and ending at (+infty, p-> y, p-> z) intersects with bb, FALSE otherwise.
(define bb-tree-stabbed
  (foreign-lambda (nonnull-c-pointer g_slist)  "gts_bb_tree_stabbed"
		  (nonnull-c-pointer g_node)
		  (nonnull-c-pointer GtsPoint)
		  ))









;; Destroy a GTS object and free the associated memory. This is the generic version, see the typed helper functions
(define object-destroy
  (foreign-lambda void "gts_object_destroy"
		  (nonnull-c-pointer GtsObject)))


(define constraint-class
  (foreign-lambda (nonnull-c-pointer GtsEdgeClass) "gts_constraint_class"))


(define point-locate
  (foreign-lambda (nonnull-c-pointer GtsFace)  "gts_point_locate"
		  (nonnull-c-pointer GtsPoint)
		  (nonnull-c-pointer GtsSurface)
		  (nonnull-c-pointer GtsFace)
		  ))

;; Create a new edge from a pair of vertices

(define gts_edge_new
  (foreign-lambda (nonnull-c-pointer GtsEdge)  "gts_edge_new"
		  (nonnull-c-pointer GtsEdgeClass)
		  (nonnull-c-pointer GtsVertex)
		  (nonnull-c-pointer GtsVertex)
		  ))

(define (edge-new v1 v2 #!key (edge-class (default-edge-class)))
  (gts_edge_new edge-class v1 v2))

;; Replaces e with with. For each triangle which uses e as an edge, e
;; is replaced with with. The with-> triangles list is updated
;; appropriately and the e-> triangles list is freed and set to NULL
(define edge-replace
  (foreign-lambda void "gts_edge_replace"
		   (nonnull-c-pointer GtsEdge) 
		   (nonnull-c-pointer GtsEdge) 
		   ))


;; Performs an "edge swap" on the two triangles sharing e and belonging to s.
(define edge-swap
  (foreign-lambda void "gts_edge_swap"
		  (nonnull-c-pointer GtsEdge) 
		  (nonnull-c-pointer GtsSurface) 
		  ))


(define segment-triangle-intersection
  (foreign-lambda (nonnull-c-pointer GtsPoint) "gts_segment_triangle_intersection"
		  (nonnull-c-pointer GtsSegment) 
		  (nonnull-c-pointer GtsTriangle) 
		  bool
		  (nonnull-c-pointer GtsPointClass)
		  ))


;; Tests if the planar projection (x, y) of p is inside or outside the
;; circumcircle of the planar projection of t. This function is
;; geometrically robust.

(define point-in-triangle-circle
  (foreign-lambda  double "gts_point_in_triangle_circle"
		   (nonnull-c-pointer GtsPoint)
		   (nonnull-c-pointer GtsTriangle) 
		   ))

;; Checks for orientation of the projection of three points on the
;; (x,y) plane. The result is also an approximation of twice the
;; signed area of the triangle defined by the three points. This
;; function uses adaptive floating point arithmetic and is
;; consequently geometrically robust.

(define point-orientation
  (foreign-lambda  double "gts_point_orientation"
		   (nonnull-c-pointer GtsPoint)
		   (nonnull-c-pointer GtsPoint)
		   (nonnull-c-pointer GtsPoint)
		   ))

;; TRUE if p is inside the surface defined by tree, FALSE otherwise.

(define point-is-inside-surface
  (foreign-lambda  bool "gts_point_is_inside_surface"
		   (nonnull-c-pointer GtsPoint)
		   (nonnull-c-pointer g_node)
		   bool
		   ))

;; Tests if the planar projection (x, y) of p is inside or outside the
;; circle defined by the planar projection of p1, p2 and p3.

(define point-in-circle
  (foreign-lambda  double "gts_point_in_circle"
		   (nonnull-c-pointer GtsPoint)
		   (nonnull-c-pointer GtsPoint)
		   (nonnull-c-pointer GtsPoint)
		   (nonnull-c-pointer GtsPoint)
		   ))

;; Checks if p4 lies above, below or on the plane passing through the
;; points p1, p2 and p3. Below is defined so that p1, p2 and p3 appear
;; in counterclockwise order when viewed from above the plane. The
;; returned value is an approximation of six times the signed volume
;; of the tetrahedron defined by the four points. This function uses
;; adaptive floating point arithmetic and is consequently
;; geometrically robust.

(define point-orientation-3d
  (foreign-lambda  double "gts_point_orientation_3d"
		   (nonnull-c-pointer GtsPoint)
		   (nonnull-c-pointer GtsPoint)
		   (nonnull-c-pointer GtsPoint)
		   (nonnull-c-pointer GtsPoint)
		   ))


;; A list of triangle strips containing all the triangles of s. A
;; triangle strip is itself a list of successive triangles having one
;; edge in common.

(define surface-strip
  (foreign-lambda  (nonnull-c-pointer g_slist) "gts_surface_strip"
		   (nonnull-c-pointer GtsSurface)
		   ))

;; Using the gts_bb_tree_surface_distance() and
;; gts_bb_tree_surface_boundary_distance() functions fills face_range
;; and boundary_range with the min, max and average Euclidean
;; (minimum) distances between the faces of s1 and the faces of s2 and
;; between the boundary edges of s1 and s2.

(define surface-distance
  (foreign-lambda  void "gts_surface_distance"
		   (nonnull-c-pointer GtsSurface)
		   (nonnull-c-pointer GtsSurface)
		   double
		   (nonnull-c-pointer GtsRange)
		   (nonnull-c-pointer GtsRange)
		   ))


;; Get the class descriptor for the GTS BBox class
(define default-bbox-class
  (foreign-lambda (nonnull-c-pointer GtsBBoxClass) "gts_bbox_class" ))


;; A new GtsBBox bounding box of surface.

(define gts_bbox_surface
  (foreign-lambda  (nonnull-c-pointer GtsRange) "gts_bbox_surface"
		   (nonnull-c-pointer GtsBBoxClass)
		   (nonnull-c-pointer GtsSurface)
		   ))


(define (bbox-surface s #!key (bbox-class (default-bbox-class)))
  (gts_bbox_surface bbox-class s))


(define bbox-x1
  (foreign-safe-lambda* double
			(((nonnull-c-pointer GtsBBox) bbox))

#<<EOF
C_return(bbox->x1);
EOF
))

(define bbox-x2
  (foreign-safe-lambda* double
			(((nonnull-c-pointer GtsBBox) bbox))

#<<EOF
C_return(bbox->x2);
EOF
))


(define bbox-y1
  (foreign-safe-lambda* double
			(((nonnull-c-pointer GtsBBox) bbox))

#<<EOF
C_return(bbox->y1);
EOF
))

(define bbox-y2
  (foreign-safe-lambda* double
			(((nonnull-c-pointer GtsBBox) bbox))

#<<EOF
C_return(bbox->y2);
EOF
))



(define bbox-z1
  (foreign-safe-lambda* double
			(((nonnull-c-pointer GtsBBox) bbox))

#<<EOF
C_return(bbox->z1);
EOF
))

(define bbox-z2
  (foreign-safe-lambda* double
			(((nonnull-c-pointer GtsBBox) bbox))

#<<EOF
C_return(bbox->z2);
EOF
))


;; TRUE if the bounding boxes bb1 and bb2 are overlapping (including
;; just touching), FALSE otherwise.

(define bboxes-are-overlapping
  (foreign-lambda  bool "gts_bboxes_are_overlapping"
		   (nonnull-c-pointer GtsBBox)
		   (nonnull-c-pointer GtsBBox)
		   ))

;; Add a constraint edge to a Delaunay surface

(define delaunay_add_constraint
  (foreign-lambda  (nonnull-c-pointer g_slist) "gts_delaunay_add_constraint"
		   (nonnull-c-pointer GtsSurface)
		   (nonnull-c-pointer GtsConstraint)
		   ))

;; NULL if the planar projection of surface is a Delaunay
;; triangulation (unconstrained), a GtsFace violating the Delaunay
;; property otherwise.

(define delaunay-check
  (foreign-lambda  (nonnull-c-pointer GtsFace) "gts_delaunay_check"
		   (nonnull-c-pointer GtsSurface)
		   ))

;; Removes all the edges of the boundary of surface which are not constraints.

(define delaunay-check-remove-hull
  (foreign-lambda  void "gts_delaunay_check_remove_hull"
		   (nonnull-c-pointer GtsSurface)
		   ))

;; Recursively split constraints of surface which are encroached by
;; vertices of surface (see Shewchuk 96 for details). The split
;; constraints are destroyed and replaced by a set of new constraints
;; of the same class. If gts_vertex_encroaches_edge() is used for
;; encroaches, the resulting surface will be Delaunay conforming. If
;; steiner_max is positive or nul, the recursive splitting procedure
;; will stop when this maximum number of Steiner points is reached. In
;; that case the resulting surface will not necessarily be Delaunay
;; conforming.

(define delaunay-conform
  (foreign-lambda  unsigned-int "gts_delaunay_conform"
		   (nonnull-c-pointer GtsSurface)
		   int
		   nonnull-c-pointer ;; GtsEncroachFunc
		   nonnull-c-pointer
		   ))

;; An implementation of the refinement algorithm described in Ruppert
;; (1995) and Shewchuk (1996).

(define delaunay-refine
  (foreign-lambda  unsigned-int "gts_delaunay_refine"
		   (nonnull-c-pointer GtsSurface)
		   int
		   nonnull-c-pointer ;; GtsEncroachFunc
		   nonnull-c-pointer
		   nonnull-c-pointer ;; GtsKeyFunc
		   nonnull-c-pointer
		   ))

;; Add one vertex to a Delaunay triangulation preserving the Delaunay
;; property

(define delaunay-add-vertex
  (foreign-lambda  (nonnull-c-pointer GtsVertex) "gts_delaunay_add_vertex"
		   (nonnull-c-pointer GtsSurface)
		   (nonnull-c-pointer GtsVertex)
		   (nonnull-c-pointer GtsFace)
		   ))

;; Add one vertex to a face of a Delaunay triangulation preserving the
;; Delaunay property

(define delaunay-add-vertex-to-face
  (foreign-lambda  (nonnull-c-pointer GtsVertex) "gts_delaunay_add_vertex_to_face"
		   (nonnull-c-pointer GtsSurface)
		   (nonnull-c-pointer GtsVertex)
		   (nonnull-c-pointer GtsFace)
		   ))

;; Removes v from the Delaunay triangulation defined by surface and
;; restores the Delaunay property. Vertex v must not be used by any
;; constrained edge otherwise the triangulation is not guaranteed to
;; be Delaunay.

(define delaunay-remove-vertex
  (foreign-lambda  void "gts_delaunay_remove_vertex"
		   (nonnull-c-pointer GtsSurface)
		   (nonnull-c-pointer GtsVertex)
		   ))

;; Typed helper functions

(define surface-destroy
  (foreign-lambda  void "surface_destroy"
		   (nonnull-c-pointer GtsSurface)
		   ))

(define triangle-destroy
  (foreign-lambda  void "triangle_destroy"
		   (nonnull-c-pointer GtsTriangle)
		   ))

(define vertex-destroy
  (foreign-lambda  void "vertex_destroy"
		   (nonnull-c-pointer GtsVertex)
		   ))



(define surface-traverse-new
  (foreign-lambda  (nonnull-c-pointer GtsSurfaceTraverse) "gts_surface_traverse_new"
		   (nonnull-c-pointer GtsSurface)
		   (nonnull-c-pointer GtsFace)
		   ))



(define gts_surface_traverse_next
  (foreign-lambda  (c-pointer GtsFace) "gts_surface_traverse_next"
		   (nonnull-c-pointer GtsSurfaceTraverse)
		   (nonnull-c-pointer unsigned-int)
		   ))

(define (surface-traverse-next t level)
  (let ((level (f64vector level)))
    (gts_surface_traverse_next t level)
    (f64vector-ref level 0)))


(define surface-traverse-destroy
  (foreign-lambda  void "gts_surface_traverse_destroy"
		   (nonnull-c-pointer GtsSurfaceTraverse)
		   ))


(define surface-tessellate
  (foreign-lambda  void "gts_surface_tessellate"
		   (nonnull-c-pointer GtsSurface)
		   nonnull-c-pointer ;; GtsRefineFunc
		   nonnull-c-pointer
		   ))


(define surface-refine
  (foreign-lambda  void "gts_surface_refine"
		   (nonnull-c-pointer GtsSurface)
		   nonnull-c-pointer ;; GtsKeyFunc
		   nonnull-c-pointer
		   nonnull-c-pointer ;; GtsRefineFunc
		   nonnull-c-pointer
		   nonnull-c-pointer ;; GtsStopFunc
		   nonnull-c-pointer
		   ))


(define edge-face-number
  (foreign-lambda  unsigned-int "gts_edge_face_number"
		   (nonnull-c-pointer GtsEdge)
		   (nonnull-c-pointer GtsSurface)))


(define edge-face-manifold-faces
  (foreign-lambda  bool "gts_edge_manifold_faces"
		   (nonnull-c-pointer GtsEdge)
		   (nonnull-c-pointer GtsSurface)
		   (nonnull-c-pointer (nonnull-c-pointer GtsFace))
		   (nonnull-c-pointer (nonnull-c-pointer GtsFace))))
		   
		   
(define edge-belongs-to-tetrahedron
  (foreign-lambda  bool "gts_edge_belongs_to_tetrahedron"
		   (nonnull-c-pointer GtsEdge)))


(define edges-from-vertices
  (foreign-lambda  (nonnull-c-pointer g_slist) "gts_edges_from_vertices"
		   (nonnull-c-pointer g_slist) 
		   (nonnull-c-pointer GtsSurface)))


(define edges-merge
  (foreign-lambda  (nonnull-c-pointer g_list) "gts_edges_merge"
		   (nonnull-c-pointer g_list) ))


(define edge-is-contact
  (foreign-lambda  unsigned-int "gts_edge_is_contact"
		   (nonnull-c-pointer GtsEdge) ))


(define edge-is-boundary
  (foreign-lambda  (nonnull-c-pointer GtsFace)  "gts_edge_is_boundary"
		   (nonnull-c-pointer GtsEdge) 
		   (nonnull-c-pointer GtsSurface) 
		   ))


(define edge-has-any-parent-surface
  (foreign-lambda  (nonnull-c-pointer GtsFace)  "gts_has_any_parent_surface"
		   (nonnull-c-pointer GtsEdge) 
		   ))



(define edge-has-parent-surface
  (foreign-lambda  (nonnull-c-pointer GtsFace)  "gts_has_parent_surface"
		   (nonnull-c-pointer GtsEdge) 
		   (nonnull-c-pointer GtsSurface) 
		   ))


(define edge-is-duplicate
  (foreign-lambda  (nonnull-c-pointer GtsEdge)  "gts_edge_is_duplicate"
		   (nonnull-c-pointer GtsEdge) 
		   ))


(define edge-is-unattached
  (foreign-lambda  bool  "gts_edge_is_unattached"
		   (nonnull-c-pointer GtsEdge) 
		   ))


;; Shutdown GTS and free all memory.
;; After calling this method no other GTS functions may be called.


(define finalize
  (foreign-lambda  void  "gts_finalize"
		   ))


(define object-reset-reserved
  (foreign-lambda  void  "object_reset_reserved"
		   (nonnull-c-pointer GtsObject)
		   ))


(define object-attributes
  (foreign-lambda  void  "gts_object_attributes"
		   (nonnull-c-pointer GtsObject)
		   (nonnull-c-pointer GtsObject)
		   ))


(define object-clone
  (foreign-lambda  (nonnull-c-pointer GtsObject)  "gts_object_clone"
		   (nonnull-c-pointer GtsObject)
		   ))

(define surface_face_revert (foreign-value "&gts_triangle_revert" c-pointer))


;; Callback interfaces

#|

;; Callback for the GTS Object class initialization - don't use this unless you know what you are doing
(define object-class-init-callback
  (foreign-lambda void  "GtsObjectClassInitFunc" (nonnull-c-pointer GtsObjectClass)))

;; Callback for the GTS Object initialization - don't use this unless you know what you are doing
(define object-init-callback
  (foreign-lambda void  "GtsObjectInitFunc" (nonnull-c-pointer GtsObject)))

;; Callback for the GTS argument set method - don't use this unless you know what you are doing
(define arg-set-callback
  (foreign-lambda void  "GtsArgSetFunc" (nonnull-c-pointer GtsObject)))

;; Callback for the GTS argument get method - don't use this unless you know what you are doing
(define arg-get-callback
  (foreign-lambda void  "GtsArgGetFunc" (nonnull-c-pointer GtsObject)))

|#

;; Callback for most GTS visitors

(define-syntax define-visitor-callback
  (syntax-rules ()
    ((_ (name arg1 arg2) body) 
     (define-external (name (c-pointer arg1) (c-pointer arg2)) int
       body))))


;; Callback for gts_vertices_merge

(define-syntax define-merge-callback
  (syntax-rules ()
    ((_ (name v1 v2) body) 
     (define-external (name ((nonnull-c-pointer GtsVertex) v1) ((nonnull-c-pointer GtsVertex) v2)) bool
       body))))

(define-syntax define-encroach-callback
  (syntax-rules ()
    ((_ (name x1 x2 x3 x4) body) 
     (define-external (name ((nonnull-c-pointer GtsVertex) x1) ((nonnull-c-pointer GtsEdge) x2)
			    ((nonnull-c-pointer GtsSurface) x3) (c-pointer x4)) bool
       body))))


(define-syntax define-key-callback
  (syntax-rules ()
    ((_ (name arg1 arg2) body) 
     (define-external (name (c-pointer arg1) (c-pointer arg2)) double
       body))))


(define-syntax define-refine-callback
  (syntax-rules ()
    ((_ (name x1 x2 x3) body) 
     (define-external (name ((nonnull-c-pointer GtsEdge) x1) ((nonnull-c-pointer GtsVertexClass) x2)
			    (c-pointer x3)) (nonnull-c-pointer GtsVertex)
       body))))

(define-syntax define-stop-callback
  (syntax-rules ()
    ((_ (name x1 x2 x3) body) 
     (define-external (name (double x1) (unsigned-int x2) (c-pointer x3)) bool
       body))))