functional points

point.ml

type vector = { x : float ; y : float }

let add_pair a b =
  { x = a.x +. b.y ; y = a.x +. b.y }

module Point = struct

  class t ~pos ~vel = object (self)
    val pos = pos
    val vel = vel
    method pos = pos
    method vel = vel
    method move = {< pos = add_pair pos vel >}
    method push accel = {< vel = add_pair vel accel >}
  end

  let make ~pos ~vel = new t ~pos ~vel
  let move (obj : #t) = obj#move
  let push (obj : #t) = obj#push

end

module Box = struct
  class t ~pos ~vel ~size = object
    inherit Point.t ~pos ~vel
    method size : vector = size
  end

  let from_point ~point ~size =
    new t ~pos:point#pos ~vel:point#vel ~size
end

module Ball = struct
  class t ~pos ~vel ~radius = object
    inherit Point.t ~pos ~vel
    method radius : float = radius
  end

  let from_point ~point ~radius =
    new t ~pos:point#pos ~vel:point#vel ~radius
end

point.mli

type vector = { x : float ; y : float }

module Point : sig
  class t :
    pos:vector ->
    vel:vector ->
    object ('a)
      method pos : vector
      method vel : vector
      method move : 'a
      method push : vector -> 'a
    end

  val make : pos:vector -> vel:vector -> t

  val move : (#t as 'a) -> 'a

  val push : (#t as 'a) -> vector -> 'a
end


module Box : sig
  class t :
   pos:vector ->
   vel:vector ->
   size:vector ->
   object ('a)
     inherit Point.t
     method size : vector
   end

  val from_point : point:#Point.t -> size:vector -> t
end

module Ball : sig
  class t :
   pos:vector ->
   vel:vector ->
   radius:float ->
   object ('a)
     inherit Point.t
     method radius : float
   end

  val from_point : point:#Point.t -> radius:float -> t
end