sig
  type point2d = int * int
  type point3d = int * int * int
  type vector2d = int * int
  type vector3d = int * int * int
  type rad_angle = int
  type deg_angle = int
  module Angle :
    sig
      module Radian :
        sig
          type t = IntAGeom.rad_angle
          val pi : IntAGeom.Angle.Radian.t
          val pi_half : IntAGeom.Angle.Radian.t
          val pi_twice : IntAGeom.Angle.Radian.t
          val of_degrees : IntAGeom.deg_angle -> IntAGeom.Angle.Radian.t
          val to_degrees : IntAGeom.Angle.Radian.t -> IntAGeom.deg_angle
          val of_radians : IntAGeom.Angle.Radian.t -> IntAGeom.Angle.Radian.t
          val to_radians : IntAGeom.Angle.Radian.t -> IntAGeom.Angle.Radian.t
          val bounded : IntAGeom.Angle.Radian.t -> IntAGeom.Angle.Radian.t
          val add :
            IntAGeom.Angle.Radian.t ->
            IntAGeom.Angle.Radian.t -> IntAGeom.Angle.Radian.t
          val sub :
            IntAGeom.Angle.Radian.t ->
            IntAGeom.Angle.Radian.t -> IntAGeom.Angle.Radian.t
          val mul : IntAGeom.Angle.Radian.t -> int -> IntAGeom.Angle.Radian.t
          val div : IntAGeom.Angle.Radian.t -> int -> IntAGeom.Angle.Radian.t
          val rand :
            ?max:IntAGeom.Angle.Radian.t -> unit -> IntAGeom.Angle.Radian.t
          val mean : IntAGeom.Angle.Radian.t list -> IntAGeom.Angle.Radian.t
          module Infix :
            sig
              val ( +. ) :
                IntAGeom.Angle.Radian.t ->
                IntAGeom.Angle.Radian.t -> IntAGeom.Angle.Radian.t
              val ( -. ) :
                IntAGeom.Angle.Radian.t ->
                IntAGeom.Angle.Radian.t -> IntAGeom.Angle.Radian.t
              val ( *. ) :
                IntAGeom.Angle.Radian.t -> int -> IntAGeom.Angle.Radian.t
              val ( /. ) :
                IntAGeom.Angle.Radian.t -> int -> IntAGeom.Angle.Radian.t
              val ( ?. ) :
                ?max:IntAGeom.Angle.Radian.t ->
                unit -> IntAGeom.Angle.Radian.t
            end
        end
      module Degree :
        sig
          type t = IntAGeom.deg_angle
          val pi : IntAGeom.Angle.Degree.t
          val pi_half : IntAGeom.Angle.Degree.t
          val pi_twice : IntAGeom.Angle.Degree.t
          val of_degrees : IntAGeom.Angle.Degree.t -> IntAGeom.Angle.Degree.t
          val to_degrees : IntAGeom.Angle.Degree.t -> IntAGeom.Angle.Degree.t
          val of_radians : IntAGeom.rad_angle -> IntAGeom.Angle.Degree.t
          val to_radians : IntAGeom.Angle.Degree.t -> IntAGeom.rad_angle
          val bounded : IntAGeom.Angle.Degree.t -> IntAGeom.Angle.Degree.t
          val add :
            IntAGeom.Angle.Degree.t ->
            IntAGeom.Angle.Degree.t -> IntAGeom.Angle.Degree.t
          val sub :
            IntAGeom.Angle.Degree.t ->
            IntAGeom.Angle.Degree.t -> IntAGeom.Angle.Degree.t
          val mul : IntAGeom.Angle.Degree.t -> int -> IntAGeom.Angle.Degree.t
          val div : IntAGeom.Angle.Degree.t -> int -> IntAGeom.Angle.Degree.t
          val rand :
            ?max:IntAGeom.Angle.Degree.t -> unit -> IntAGeom.Angle.Degree.t
          val mean : IntAGeom.Angle.Degree.t list -> IntAGeom.Angle.Degree.t
          module Infix :
            sig
              val ( +. ) :
                IntAGeom.Angle.Degree.t ->
                IntAGeom.Angle.Degree.t -> IntAGeom.Angle.Degree.t
              val ( -. ) :
                IntAGeom.Angle.Degree.t ->
                IntAGeom.Angle.Degree.t -> IntAGeom.Angle.Degree.t
              val ( *. ) :
                IntAGeom.Angle.Degree.t -> int -> IntAGeom.Angle.Degree.t
              val ( /. ) :
                IntAGeom.Angle.Degree.t -> int -> IntAGeom.Angle.Degree.t
              val ( ?. ) :
                ?max:IntAGeom.Angle.Degree.t ->
                unit -> IntAGeom.Angle.Degree.t
            end
        end
    end
  module Point2d :
    sig
      type t = IntAGeom.point2d
      val of_point3d : IntAGeom.point3d -> IntAGeom.Point2d.t
      val sq_dist : IntAGeom.Point2d.t -> IntAGeom.Point2d.t -> int
      val midpoint :
        IntAGeom.Point2d.t -> IntAGeom.Point2d.t -> IntAGeom.Point2d.t
      val dot : IntAGeom.Point2d.t -> IntAGeom.Point2d.t -> int
      val rand :
        IntAGeom.Point2d.t -> IntAGeom.Point2d.t -> IntAGeom.Point2d.t
      module Infix :
        sig
          val ( -|- ) :
            IntAGeom.Point2d.t -> IntAGeom.Point2d.t -> IntAGeom.Point2d.t
          val ( <=> ) : IntAGeom.Point2d.t -> IntAGeom.Point2d.t -> int
          val ( ?. ) :
            IntAGeom.Point2d.t -> IntAGeom.Point2d.t -> IntAGeom.Point2d.t
        end
    end
  module Point3d :
    sig
      type t = IntAGeom.point3d
      val of_point2d : ?z:int -> IntAGeom.point2d -> IntAGeom.Point3d.t
      val sq_dist : IntAGeom.Point3d.t -> IntAGeom.Point3d.t -> int
      val midpoint :
        IntAGeom.Point3d.t -> IntAGeom.Point3d.t -> IntAGeom.Point3d.t
      val rand :
        IntAGeom.Point3d.t -> IntAGeom.Point3d.t -> IntAGeom.Point3d.t
      module Infix :
        sig
          val ( -|- ) :
            IntAGeom.Point3d.t -> IntAGeom.Point3d.t -> IntAGeom.Point3d.t
          val ( <=> ) : IntAGeom.Point3d.t -> IntAGeom.Point3d.t -> int
          val ( ?. ) :
            IntAGeom.Point3d.t -> IntAGeom.Point3d.t -> IntAGeom.Point3d.t
        end
    end
  module Vector2d :
    sig
      type t = IntAGeom.vector2d
      val of_points :
        IntAGeom.Point2d.t -> IntAGeom.Point2d.t -> IntAGeom.Vector2d.t
      val add :
        IntAGeom.Vector2d.t -> IntAGeom.Vector2d.t -> IntAGeom.Vector2d.t
      val sub :
        IntAGeom.Vector2d.t -> IntAGeom.Vector2d.t -> IntAGeom.Vector2d.t
      val mul : IntAGeom.Vector2d.t -> int -> IntAGeom.Vector2d.t
      val div : IntAGeom.Vector2d.t -> int -> IntAGeom.Vector2d.t
      val dot : IntAGeom.Vector2d.t -> IntAGeom.Vector2d.t -> int
      val length : IntAGeom.Vector2d.t -> int
      val normalise : IntAGeom.Vector2d.t -> IntAGeom.Vector2d.t
      module Infix :
        sig
          val ( +. ) :
            IntAGeom.Vector2d.t -> IntAGeom.Vector2d.t -> IntAGeom.Vector2d.t
          val ( -. ) :
            IntAGeom.Vector2d.t -> IntAGeom.Vector2d.t -> IntAGeom.Vector2d.t
          val ( *. ) : IntAGeom.Vector2d.t -> int -> IntAGeom.Vector2d.t
          val ( /. ) : IntAGeom.Vector2d.t -> int -> IntAGeom.Vector2d.t
          val ( !. ) : IntAGeom.Vector2d.t -> IntAGeom.Vector2d.t -> int
          val ( ~. ) : IntAGeom.Vector2d.t -> IntAGeom.Vector2d.t
        end
    end
  module Vector3d :
    sig
      type t = IntAGeom.vector3d
      val of_points :
        IntAGeom.Point3d.t -> IntAGeom.Point3d.t -> IntAGeom.Vector3d.t
      val add :
        IntAGeom.Vector3d.t -> IntAGeom.Vector3d.t -> IntAGeom.Vector3d.t
      val sub :
        IntAGeom.Vector3d.t -> IntAGeom.Vector3d.t -> IntAGeom.Vector3d.t
      val mul : IntAGeom.Vector3d.t -> int -> IntAGeom.Vector3d.t
      val div : IntAGeom.Vector3d.t -> int -> IntAGeom.Vector3d.t
      val dot : IntAGeom.Vector3d.t -> IntAGeom.Vector3d.t -> int
      val sq_length : IntAGeom.Vector3d.t -> int
      val normalise : IntAGeom.Vector3d.t -> IntAGeom.Vector3d.t
      val cross :
        IntAGeom.Vector3d.t -> IntAGeom.Vector3d.t -> IntAGeom.Vector3d.t
      module Infix :
        sig
          val ( +. ) :
            IntAGeom.Vector3d.t -> IntAGeom.Vector3d.t -> IntAGeom.Vector3d.t
          val ( -. ) :
            IntAGeom.Vector3d.t -> IntAGeom.Vector3d.t -> IntAGeom.Vector3d.t
          val ( *. ) : IntAGeom.Vector3d.t -> int -> IntAGeom.Vector3d.t
          val ( /. ) : IntAGeom.Vector3d.t -> int -> IntAGeom.Vector3d.t
          val ( !. ) : IntAGeom.Vector3d.t -> IntAGeom.Vector3d.t -> int
          val ( ~. ) : IntAGeom.Vector3d.t -> IntAGeom.Vector3d.t
        end
    end
  module Curves2d :
    sig
      module Bezier :
        sig
          module Linear :
            sig
              val interval : int * int
              val pnt :
                IntAGeom.Point2d.t * IntAGeom.Point2d.t ->
                int -> IntAGeom.Point2d.t
              val drv :
                IntAGeom.Point2d.t * IntAGeom.Point2d.t ->
                int -> IntAGeom.Vector2d.t
              val rand :
                IntAGeom.Point2d.t ->
                IntAGeom.Point2d.t -> IntAGeom.Point2d.t * IntAGeom.Point2d.t
            end
          module Quadratic :
            sig
              val interval : int * int
              val pnt :
                IntAGeom.Point2d.t * IntAGeom.Point2d.t * IntAGeom.Point2d.t ->
                int -> IntAGeom.Point2d.t
              val drv :
                IntAGeom.Point2d.t * IntAGeom.Point2d.t * IntAGeom.Point2d.t ->
                int -> IntAGeom.Vector2d.t
              val rand :
                IntAGeom.Point2d.t ->
                IntAGeom.Point2d.t ->
                IntAGeom.Point2d.t * IntAGeom.Point2d.t * IntAGeom.Point2d.t
            end
          module Cubic :
            sig
              val interval : int * int
              val pnt :
                IntAGeom.Point2d.t * IntAGeom.Point2d.t *
                IntAGeom.Point2d.t * IntAGeom.Point2d.t ->
                int -> IntAGeom.Point2d.t
              val drv :
                IntAGeom.Point2d.t * IntAGeom.Point2d.t *
                IntAGeom.Point2d.t * IntAGeom.Point2d.t ->
                int -> IntAGeom.Vector2d.t
              val rand :
                IntAGeom.Point2d.t ->
                IntAGeom.Point2d.t ->
                IntAGeom.Point2d.t * IntAGeom.Point2d.t *
                IntAGeom.Point2d.t * IntAGeom.Point2d.t
            end
        end
    end
  module Curves3d :
    sig
      module Bezier :
        sig
          module Linear :
            sig
              val interval : int * int
              val pnt :
                IntAGeom.Point3d.t * IntAGeom.Point3d.t ->
                int -> IntAGeom.Point3d.t
              val drv :
                IntAGeom.Point3d.t * IntAGeom.Point3d.t ->
                int -> IntAGeom.Vector3d.t
              val rand :
                IntAGeom.Point3d.t ->
                IntAGeom.Point3d.t -> IntAGeom.Point3d.t * IntAGeom.Point3d.t
            end
          module Quadratic :
            sig
              val interval : int * int
              val pnt :
                IntAGeom.Point3d.t * IntAGeom.Point3d.t * IntAGeom.Point3d.t ->
                int -> IntAGeom.Point3d.t
              val drv :
                IntAGeom.Point3d.t * IntAGeom.Point3d.t * IntAGeom.Point3d.t ->
                int -> IntAGeom.Vector3d.t
              val rand :
                IntAGeom.Point3d.t ->
                IntAGeom.Point3d.t ->
                IntAGeom.Point3d.t * IntAGeom.Point3d.t * IntAGeom.Point3d.t
            end
          module Cubic :
            sig
              val interval : int * int
              val pnt :
                IntAGeom.Point3d.t * IntAGeom.Point3d.t *
                IntAGeom.Point3d.t * IntAGeom.Point3d.t ->
                int -> IntAGeom.Point3d.t
              val drv :
                IntAGeom.Point3d.t * IntAGeom.Point3d.t *
                IntAGeom.Point3d.t * IntAGeom.Point3d.t ->
                int -> IntAGeom.Vector3d.t
              val rand :
                IntAGeom.Point3d.t ->
                IntAGeom.Point3d.t ->
                IntAGeom.Point3d.t * IntAGeom.Point3d.t *
                IntAGeom.Point3d.t * IntAGeom.Point3d.t
            end
        end
    end
end