Chapter 13: Classes

Classes

One of the main goals of OOP is code-reuse via inheritance and that’s why we need to have a good understanding of OCaml classes. A class is a recipe for creating objects, and that recipe can be changed by adding new methods and fields or modifying existing methods.

OCaml Classes #

Classes have class-types which describes the class itself and class-types are separate from regular OCaml types.
Class types should not be confused with object types.
- Class Type: object ... end
- object type: e.g. < get : int; .. >
we produce objects from the class using new
While it’s true that classes and class names are NOT types, for convenience, the definition of class istack also defines and object type istack with the same methods as the class. NOTE: the istack object type represents any objects with these methods, NOT just objects created by the istack class.

(* === 1: defining a class: *)
open Base;;
class istack = object
  val mutable v = [0; 2]

  method pop =
    match v with
    | hd :: tl ->
      v <- tl;
      Some hd
    | [] -> None

  method push hd =
    v <- hd :: v
end;;
(*
class istack :
  object
    val mutable v : int list
    method pop : int option
    method push : int -> unit
  end
  *)

(* ==== 2: producing an object: *)
let s = new istack;;
(* val s : istack = <obj> *) (*<== istack object type created automatically that looks like the istack class definition's signature*)
s#pop;;
(* - : int option = Some 0 *)
s#push 5;;
(* - : unit = () *)
s#pop;;
(* - : int option = Some 5 *)

Class Parameters and Polymorphism #

A class definition is the constructor, we may pass in arguments when the object is created with new.

constructor params can be:
- type params
  - Type params for the class are placed in square brackets before the class name in the class definition.
- constructor params
we need to provide enough constraints so that the compiler will infer the correct type.
To achieve this, we can add type constraints to:
1. parameters
2. fields
3. methods
Usually, we’d just annotate the fields and/or class params and add constraints to the methods only if necessary.

class ['a] stack init = object
  val mutable v : 'a list = init (*<-- type annotation for v helps us constraint the type inference else it would be "too polymorphic"*)

  method pop =
    match v with
    | hd :: tl ->
      v <- tl;
      Some hd
    | [] -> None

  method push hd =
    v <- hd :: v
end;;
(*
class ['a] stack :
  'a list ->
  object
    val mutable v : 'a list
    method pop : 'a option
    method push : 'a -> unit
  end
*)

Object Types as Interfaces #

Suppose we wish to traverse the elements on our stack. In the OOP world, we would have defined a class for the iterator object which would have given us a generic mechanism to inspect and traverse the elements of a collection.

Typically languages use 2 mechanisms to define an abstract interface like this:

like in java, an iterator interface:

   // Java-style iterator, specified as an interface.
   interface <T> iterator {
     T Get();
     boolean HasValue();
     void Next();
   };

in languages without interfaces (like C++), using abstract classes without implementation them:

   // Abstract class definition in C++.
   template<typename T>
   class Iterator {
    public:
     virtual ~Iterator() {}
     virtual T get() const = 0;
     virtual bool has_value() const = 0;
     virtual void next() = 0;
   };

OCaml supports both styles, and gives more flexibility: an object type can be implemented by any object with the appropriate methods. It doesn’t need to be specified by the object’s class a priori.

Object classes used as an interface #

(* === 1: defining the object type for iterator and the functions it requires*)
type 'a iterator = < get : 'a; has_value : bool; next : unit >;;
(* type 'a iterator = < get : 'a; has_value : bool; next : unit > *)

(* === 2: defining the actual iterator class for lists. This will produce objects that will satisfy the iterator object type that we have defined above. *)
class ['a] list_iterator init = object
  val mutable current : 'a list = init

  method has_value = not (List.is_empty current)

  method get =
    match current with
    | hd :: tl -> hd
    | [] -> raise (Invalid_argument "no value")

  method next =
    match current with
    | hd :: tl -> current <- tl
    | [] -> raise (Invalid_argument "no value")
end;;
(*
class ['a] list_iterator :
  'a list ->
  object
    val mutable current : 'a list
    method get : 'a
    method has_value : bool
    method next : unit
  end
  *)

(* === 3: we add the iterator method to the stack class that produces an interator *)
class ['a] stack init = object
  val mutable v : 'a list = init

  method pop =
    match v with
    | hd :: tl ->
      v <- tl;
      Some hd
    | [] -> None

  method push hd =
    v <- hd :: v

  (** This produces an iterator, for which we construct a list_iterator object that refers to the current contents of the stack. *)
  method iterator : 'a iterator =
    new list_iterator v
end;;
(*
class ['a] stack :
  'a list ->
  object
    val mutable v : 'a list
    method iterator : 'a iterator
    method pop : 'a option
    method push : 'a -> unit
  end
  *)

(* ==== USAGE:  *)
let s = new stack [];;
(* val s : '_weak1 stack = <obj> *)
s#push 5;;
(* - : unit = () *)
s#push 4;;
(* - : unit = () *)
let it = s#iterator;;
(* val it : int iterator = <obj> *)
it#get;;
(* - : int = 4 *)
it#next;;
(* - : unit = () *)
it#get;;
(* - : int = 5 *)
it#next;;
(* - : unit = () *)
it#has_value;;
(* - : bool = false *)

Functional Iterators #

Why take the trouble to implement an interator interface when we are using a functional language. lol.

We apply the usual functional patterns:

iter

fold

which is polymorphic and has this type: ('b -> 'a -> 'b) -> 'b -> 'b
the 'a is already within the class type param, for 'b, we need to use a type quantifier like below:
SYNTAX AWKWARDNESS: 'b. is the type quantifier that should be read as “for all 'b”. They can only be used DIRECTLY after the method name \(\implies\) method params must be expressed using a fun or function expression.

   class ['a] stack init = object
     val mutable v : 'a list = init

     method pop =
       match v with
       | hd :: tl ->
         v <- tl;
         Some hd
       | [] -> None

     method push hd =
       v <- hd :: v

     (* -- type quantifier*)
     method fold : 'b. ('b -> 'a -> 'b) -> 'b -> 'b =
       (fun f init -> List.fold ~f ~init v)
   end;;
   (*
   class ['a] stack :
     'a list ->
     object
       val mutable v : 'a list
       method fold : ('b -> 'a -> 'b) -> 'b -> 'b
       method pop : 'a option
       method push : 'a -> unit
     end
     *)

Inheritance #

We can create subclasses that inherit from the parent class and:

add new functionality e.g. adding this print method

we can directly inherit from the class using inherit keyword

   class sstack init = object
     inherit [string] stack init

     method print =
       List.iter ~f:Stdio.print_endline v
   end;;
   (*
   class sstack :
     string list ->
     object
       val mutable v : string list
       method pop : string option
       method print : unit
       method push : string -> unit
     end
     *)

override existing methods

we access the original method using as super statement. This creates a special super object through which we can call superclass methods. It’s not a real object though, just a good mental model.

   class double_stack init = object
     inherit [int] stack init as super

     method push hd =
       super#push (hd * 2)
   end;;
   (*
   class double_stack :
     int list ->
     object
       val mutable v : int list
       method pop : int option
       method push : int -> unit
     end
     *)

Class Types #

Purpose of a class type is for exposure to other files or modules via a module signature. We may wish to include the classes in module’s signature that is exposed because other modules may inherit from class definitions. To do this we need to specify the class types.

Using class types is not as mainstream in OOP languages. The idea is that a class type specifies the type of each VISIBLE parts of the class, INCLUDING fields and methods. Whatever we omit gets hidden.

Now, we have multiple choices in defining the module type, depending on how much of the implementation we want to expose.

one extreme: maximally abstract signature that completely hides the class definitions
this completely ignores the classes.
We may wish to include the classes in module’s signature that is exposed because other modules may inherit from class definitions. To do this we need to specify the class types.

module Stack = struct
  class ['a] stack init = object
    val mutable v : 'a list = init

    method pop =
      match v with
      | hd :: tl ->
         v <- tl;
         Some hd
      | [] -> None

    method push hd =
      v <- hd :: v
  end

  (** type t defined for the type of our stacks *)
  type 'a t = 'a stack

  let make init = new stack init
end

(*=== defining the module type (the signature we'd put in the interface file): extreme: maximally abstract:  *)
module AbstractStack : sig
   type 'a t = < pop: 'a option; push: 'a -> unit >

   val make : 'a list -> 'a t
end = Stack

(* === including class types, exposing them via the interface. *)
module VisibleStack : sig

  type 'a t = < pop: 'a option; push: 'a -> unit >

  class ['a] stack : object
    val mutable v : 'a list
    method pop : 'a option
    method push : 'a -> unit
  end

  val make : 'a list -> 'a t
end = Stack

Open Recursion #

We’ve seen this before. It’s useful because of the dynamic dispatch that we can do. We can use open recursion for cases where using data types or modules would be hard to do.

Open Recursion:

allows object’s methods to invoke other methods on the same object
allows a method in one class to call a method from another class if both classes are inherited by the same object.
This allows mutually recursive parts of an object to be defined separately.
Key feature of classes: This ability to define mutually recursive methods. If we did it using data types or modules it would have been much more cumbersome and verbose.

example: recursive traversal of a document structure #

IF we had to traverse a document and we only had types defined for a tree with different types of nodes:

type doc =
  | Heading of string
  | Paragraph of text_item list
  | Definition of string list_item list

and text_item =
  | Raw of string
  | Bold of text_item list
  | Enumerate of int list_item list
  | Quote of doc

and 'a list_item =
  { tag: 'a;
    text: text_item list }

It’s not as easy to factor out the common parts of these functions and we likely would have to write recursive code multiple times.

Better way is to define a class and use open recursion. The class just has to define objects that fold over the document data.

Below,

object(self) binds self to the current object which allows the open recursive calls to happen.
we could even inherit from this class and add functionality:

class ['a] folder = object(self)
  method doc acc = function
  | Heading _ -> acc
  | Paragraph text -> List.fold ~f:self#text_item ~init:acc text
  | Definition list -> List.fold ~f:self#list_item ~init:acc list

  method list_item: 'b. 'a -> 'b list_item -> 'a =
    fun acc {tag; text} ->
      List.fold ~f:self#text_item ~init:acc text

  method text_item acc = function
  | Raw _ -> acc
  | Bold text -> List.fold ~f:self#text_item ~init:acc text
  | Enumerate list -> List.fold ~f:self#list_item ~init:acc list
  | Quote doc -> self#doc acc doc
end


class counter = object
  inherit [int] folder as super

  method list_item acc li = acc

  method text_item acc ti =
    let acc = super#text_item acc ti in (* super special obj used to call the [int] folder class's text_item method to fold over the children of text_item*)
    match ti with
    | Bold _ -> acc + 1
    | _ -> acc
end

let count_doc = (new counter)#doc

Private Methods #

Are actually more like protected methods since OCaml private methods can be called by subclasses.

Private methods are part of the class type but NOT part of the object type (for objects that are produced from the class). This is what allows subclasses to have access to private methods.

In the example here, we might not want to force subclasses of folder to expose the nitty gritty methods for each of the different doc and text_item cases.

class ['a] folder2 = object(self)
  method doc acc = function
  | Heading str -> self#heading acc str
  | Paragraph text -> self#paragraph acc text
  | Definition list -> self#definition acc list

  method list_item: 'b. 'a -> 'b list_item -> 'a =
    fun acc {tag; text} ->
      List.fold ~f:self#text_item ~init:acc text

  method text_item acc = function
  | Raw str -> self#raw acc str
  | Bold text -> self#bold acc text
  | Enumerate list -> self#enumerate acc list
  | Quote doc -> self#quote acc doc

  method private heading acc str = acc
  method private paragraph acc text =
    List.fold ~f:self#text_item ~init:acc text
  method private definition acc list =
    List.fold ~f:self#list_item ~init:acc list

  method private raw acc str = acc
  method private bold acc text =
    List.fold ~f:self#text_item ~init:acc text
  method private enumerate acc list =
    List.fold ~f:self#list_item ~init:acc list
  method private quote acc doc = self#doc acc doc
end

(*-- the building of this value shows how the instantiated folder2 object hides private methods*)
let f :
  < doc : int -> doc -> int;
    list_item : 'a . int -> 'a list_item -> int;
    text_item : int -> text_item -> int >  = new folder2



(* ==== we can access private methods from within subclasses because of the access to the class type. *)
class counter_with_private_method = object
  inherit [int] folder2 as super

  method list_item acc li = acc

  method private bold acc txt =
    let acc = super#bold acc txt in
    acc + 1
end

If we wish to have TRULY private classes that no one can access, we just need to omit it from the signature:

class counter_with_sig : object
  method doc : int -> doc -> int
  method list_item : int -> 'b list_item -> int
  method text_item : int -> text_item -> int
end = object
  inherit [int] folder2 as super

  method list_item acc li = acc

  method private bold acc txt =
    let acc = super#bold acc txt in
    acc + 1
end

Binary Methods #

A method that takes in an object of self type e.g. for equality. Equality check is somewhat of an extreme case for binary methods because it needs a full info on the objects for comparisons. In many cases, binary functions likely only need partial info (e.g. is_bigger for an arbitrary shape).

we can get the type of the current object using (self: 'self) type annotation
the code below is only allows objects of the same type to be compared and this is a specific problem we need to solve.

class square w = object(self : 'self)
  method width = w
  method area = Float.of_int (self#width * self#width)
  method equals (other : 'self) = other#width = self#width
end;;
(*
class square :
  int ->
  object ('a)
    method area : float
    method equals : 'a -> bool
    method width : int
  end
  *)
class circle r = object(self : 'self)
  method radius = r
  method area = 3.14 *. (Float.of_int self#radius) **. 2.0
  method equals (other : 'self) = other#radius = self#radius
end;;
(*
class circle :
  int ->
  object ('a)
    method area : float
    method equals : 'a -> bool
    method radius : int
  end
   *)

(* usage: *)
(new square 5)#equals (new square 5);;
(* - : bool = true *)
(new circle 10)#equals (new circle 7);;
(* - : bool = false *)

Our objective is to use a common base shape class and be able to compare equality. At the moment a square=/=circle only expects to be compared with itself and not an arbitrary shape. Other languages would typically solve it using type narrowing or dynamic type-checking. OCaml can’t do that.

why using Polymorphic equality won’t work #

Approach that won’t work :

instead of using the equality method within the base type shape, we use the polymorphic equality instead.

This has problems:

the builtin polymorphic equality has poor behaviour when used with objects.
the builtin polymorphic equality only considers two things as equal if they’re physically equal \(\implies\) we’ll get many false negatives
```
   Poly.(=)
     (object method area = 5 end)
     (object method area = 5 end);;
   (* - : bool = false *)
```

using a representation type and a `repr` method for equality #

Approach that works:

In general, we can use the same solution we used for narrowing: using a representation type implemented using variants and implementing comparisons based on the representation type. We need to expose the repr method, but we may hide the type definition for it.


(* ==== exposing the repr method (and hiding the type definition) *)
module Shapes : sig
  type shape_repr
  type shape =
    < repr : shape_repr; equals : shape -> bool; area: float >

  class square : int ->
                 object
                   method width : int
                   method area : float
                   method repr : shape_repr
                   method equals : shape -> bool
                 end
end = struct
  type shape_repr =
    | Square of int
    | Circle of int;;
  (* type shape_repr = Square of int | Circle of int *)
  type shape =
    < repr : shape_repr; equals : shape -> bool; area : float >;;
  (* type shape = < area : float; equals : shape -> bool; repr : shape_repr > *)
  class square w = object(self)
    method width = w
    method area = Float.of_int (self#width * self#width)
    method repr = Square self#width
    method equals (other : shape) =
      match (self#repr, other#repr) with
      | Square x, Square x' -> Int.(=) x x'
      | _ -> false
  end;;
(*
  class square :
  int ->
  object
  method area : float
  method equals : shape -> bool
  method repr : shape_repr
  method width : int
  end
 *)
end

using extensible variants #

In the previous section, we had a new problem that we could only add new kinds of shapes if we added new constructors to the shape_repr type (i.e. add new tags to the variant type).

Extensible variants separate the definition of a variant type from the definition of its constructors. So it’s an open type and new variants can always be added.

The compiler can’t do exhaustiveness checks on such open types though.
objects created by these classes are in one-to-one correspondence with members of the representation type so the objects seem somewhat redundant.

type shape_repr = ..;;
(* type shape_repr = .. *)
type shape =
< repr : shape_repr; equals : shape -> bool; area : float >;;
(*
type shape = < area : float; equals : shape -> bool; repr : shape_repr >
*)

(* == adding new constructors *)
type shape_repr += Square of int;;
(* type shape_repr += Square of int *)
class square w = object(self)
  method width = w
  method area = Float.of_int (self#width * self#width)
  method repr = Square self#width
  method equals (other : shape) =
     match (self#repr, other#repr) with
     | Square x, Square x' -> Int.(=) x x'
     | _ -> false
end;;
(*
class square :
  int ->
  object
    method area : float
    method equals : shape -> bool
    method repr : shape_repr
    method width : int
  end
  *)

partial information for binary methods #

Equality check is an extreme and in many cases we just need partial information. The larger method can be used on a square and also on any object of the type shape.

class square w = object(self)
  method width = w
  method area = Float.of_int (self#width * self#width)
  method larger (other : shape) = Float.(self#area > other#area)
end;;
(*
class square :
  int ->
  object
    method area : float
    method larger : shape -> bool
    method width : int
  end
*)

Virtual Classes and Methods #

OCaml’s use of the word virtual is different from others like C++ (where virtual == dynamic dispatch). In OCaml, all methods use dynamic dispatch.

A virtual class is like a functor because the “inputs” are declared (but not defined) i.e. the virtual methods and fields. “Applying the functor” happens by subclasses doing inheritance: when virtual methods are given concrete implementations.

So virtual means:

method / field in the virtual class is declared but not implemented. In this case both the method/field AND the class are flagged as virtual and can’t be directly instantiated.

Create Some Simple Shapes #

For the example below, we realise that there’s some commonalities between the two classes that we can shift into a superclass:

definitions of x and y
on_click depends on contains and the implementation of contains differs for different shapes \(\implies\) a good candidate for contains to be a virtual method within a virtual class, thereby allowing the definition of contains to be the subclass’s responsibility.

open Core
open Async
open Async_graphics

(* the ability to describe how to draw the shape on Async_graphics *)
type drawable = < draw: unit >

class square w x y = object(self)
  val mutable x: int = x
  method x = x

  val mutable y: int = y
  method y = y

  val mutable width = w
  method width = width

  (** Shows how to draw the shape using Async_graphics*)
  method draw = fill_rect x y width width

  method private contains x' y' =
    x <= x' && x' <= x + width &&
      y <= y' && y' <= y + width

  (** for adding event-handlers to shapes*)
  method on_click ?start ?stop f =
    on_click ?start ?stop
      (fun ev ->
         if self#contains ev.mouse_x ev.mouse_y then
           f ev.mouse_x ev.mouse_y)
end

class circle r x y = object(self)
  val mutable x: int = x
  method x = x

  val mutable y: int = y
  method y = y

  val mutable radius = r
  method radius = radius

  method draw = fill_circle x y radius

  method private contains x' y' =
    let dx = x' - x in
    let dy = y' - y in
      dx * dx + dy * dy <= radius * radius

  method on_click ?start ?stop f =
    on_click ?start ?stop
      (fun ev ->
         if self#contains ev.mouse_x ev.mouse_y then
           f ev.mouse_x ev.mouse_y)
end

And this is our virtual class:

class virtual shape x y = object(self)
  (* virtual method -- implementation left to the subclass. *)
  method virtual private contains: int -> int -> bool

  val mutable x: int = x
  method x = x

  val mutable y: int = y
  method y = y

  method on_click ?start ?stop f =
    on_click ?start ?stop
      (fun ev ->
         if self#contains ev.mouse_x ev.mouse_y then
           f ev.mouse_x ev.mouse_y)

  method on_mousedown ?start ?stop f =
    on_mousedown ?start ?stop
      (fun ev ->
         if self#contains ev.mouse_x ev.mouse_y then
           f ev.mouse_x ev.mouse_y)
end

(* === implementing the subclasses: *)
class square w x y = object
  inherit shape x y

  val mutable width = w
  method width = width

  method draw = fill_rect x y width width

  method private contains x' y' =
    x <= x' && x' <= x + width &&
    y <= y' && y' <= y + width
end

class circle r x y = object
  inherit shape x y

  val mutable radius = r
  method radius = radius

  method draw = fill_circle x y radius

  method private contains x' y' =
    let dx = x' - x in
    let dy = y' - y in
      dx * dx + dy * dy <= radius * radius
end

Initializers #

Init functions are common in OOP world, we have them in OCaml.

To add in expressions that are executed during instantiation of a class. These expressions can’t refer to the methods of the object because they run before the object’s creation:

place the expressions before the object expression
place the expressions in the initial value of a field

If we wish to make references to methods of the object, then we need to do it differently. We need to use initializers.

(* === using expressions before the object creation: *)
class obj x =
  let () = Stdio.printf "Creating obj %d\n" x in
  object
    val field = Stdio.printf "Initializing field\n"; x
end;;
(* class obj : int -> object val field : int end *)
let o = new obj 3;;
(*
Creating obj 3
Initializing field
val o : obj = <obj>
*)


(* === using initializers *)
class growing_circle r x y = object(self)
  inherit circle r x y

  initializer
    (* we are using the inherited on-click to add a handler for click events *)
    self#on_click (fun _x _y -> radius <- radius * 2)
end

Multiple Inheritance #

OCaml’s support for multiple inheritance means that we have a variety of ways that classes can be combined, useful especially with the use of virtual classes.

The tricky part is when the inheritance heirarchy is less of a tree and more of a graph and so we should be cautioned against that.

How Names are Resolved #

This is about name-clashes.

Inheritance is like *textual inclusion – if there’s more than one definition of a name, the last one wins.

Really the most recent definition for that name is what matters if we have clashes.

class square_outline w x y = object
  inherit square w x y
  (* == this draw method is latest defintion -- this is what is used *)
  method draw = draw_rect x y width width
end

class square_outline w x y = object
  method draw = draw_rect x y w w
  (* == the draw method inherited from the superclas (square) is the latest definition, so that is what is used. *)
  inherit square w x y
end

a reiteration of what inheritance means:

replace each inherit directive with its definition
take the last definition of each method or field.
Note that the methods and fields added by an inheritance are those listed in its class type, so private methods that are hidden by the type will not be included.

Mixins #

Many opinions about multiple inheritance:

that it’s overly complicated
problematic in general and we should use object composition instead

Nevertheless, one general pattern for multiple inheritance that is useful and simple: using the mixin pattern.

Mixins:

just a virtual class implementing a feature based on another one
If you have a class that implements methods A, and you have a mixin M that provides methods B from A, then you can inherit from M—“mixing” it in—to get features B.

Example is one of mouse-draggability and animation for the shapes we have had:

(* ==== mixin: allowing the object to be draggable. *)
class virtual draggable = object(self)
  method virtual on_mousedown:
    ?start:unit Deferred.t ->
    ?stop:unit Deferred.t ->
    (int -> int -> unit) -> unit
  val virtual mutable x: int
  val virtual mutable y: int

  val mutable dragging = false
  method dragging = dragging

  initializer
    self#on_mousedown
      (fun mouse_x mouse_y ->
         let offset_x = x - mouse_x in
         let offset_y = y - mouse_y in
         let mouse_up = Ivar.create () in
         let stop = Ivar.read mouse_up in
         dragging <- true;
         on_mouseup ~stop
           (fun _ ->
              Ivar.fill mouse_up ();
              dragging <- false);
         on_mousemove ~stop
           (fun ev ->
              x <- ev.mouse_x + offset_x;
              y <- ev.mouse_y + offset_y))
end

class small_square = object
  inherit square 20 40 40
  inherit draggable
end

(* ==== mixin: animated shapes *)
class virtual animated span = object(self)
  method virtual on_click:
    ?start:unit Deferred.t ->
    ?stop:unit Deferred.t ->
    (int -> int -> unit) -> unit
  val mutable updates: (int -> unit) list = []
  val mutable step = 0
  val mutable running = false

  method running = running

  method animate =
    step <- 0;
    running <- true;
    let stop =
      Clock.after span
      >>| fun () -> running <- false
    in
    Clock.every ~stop (Time.Span.of_sec (1.0 /. 24.0))
      (fun () ->
         step <- step + 1;
         List.iter ~f:(fun f -> f step) updates
      )

  initializer
    self#on_click (fun _x _y -> if not self#running then self#animate)
end
(* --- usage: class will produce circles that move right for a second when clicked. *)
class my_circle = object
  inherit circle 20 50 50
  inherit animated Time.Span.second
  initializer updates <- [fun _ -> x <- x + 5]
end

The initialisers can be added using mixins as well. What’s interesting is because the mixin examples below are only used for side-effects, we can inherit them multiple times to get different animations.

class virtual linear x' y' = object
  val virtual mutable updates: (int -> unit) list
  val virtual mutable x: int
  val virtual mutable y: int

  initializer
    let update _ =
      x <- x + x';
      y <- y + y'
    in
    updates <- update :: updates
end

let pi = (Float.atan 1.0) *. 4.0

class virtual harmonic offset x' y' = object
  val virtual mutable updates: (int -> unit) list
  val virtual mutable x: int
  val virtual mutable y: int

  initializer
    let update step =
      let m = Float.sin (offset +. ((Float.of_int step) *. (pi /. 64.))) in
      let x' = Float.to_int (m *. Float.of_int x') in
      let y' = Float.to_int (m *. Float.of_int y') in
      x <- x + x';
      y <- y + y'
    in
    updates <- update :: updates
end


(* ==== inheriting the mixins multiple times *)
class my_square x y = object
  inherit square 40 x y
  inherit draggable
  inherit animated (Time.Span.of_int_sec 5)
  inherit linear 5 0
  inherit harmonic 0.0 7 ~-10
end

let my_circle = object
  inherit circle 30 250 250
  inherit animated (Time.Span.minute)
  inherit harmonic 0.0 10 0
  inherit harmonic (pi /. 2.0) 0 10
end

Displaying the Animated Shapes #

This is more of a wrap-up section to the examples.

We finish our shapes module by creating a main function to draw some shapes on the graphical display and running that function using the Async scheduler:

let main () =
  let shapes = [
     (my_circle :> drawable);
     (new my_square 50 350 :> drawable);
     (new my_square 50 200 :> drawable);
     (new growing_circle 20 70 70 :> drawable);
  ] in
  let repaint () =
    clear_graph ();
    List.iter ~f:(fun s -> s#draw) shapes;
    synchronize ()
  in
    open_graph "";
    auto_synchronize false;
    Clock.every (Time.Span.of_sec (1.0 /. 24.0)) repaint

let () = never_returns (Scheduler.go_main ~main ())

The OCaml builtin graphics functionality is more of a learning tool.

There are better packages / bindings out there:

Lablgtk – based on gtk
LablGL – uses OpenGL
js_of_ocaml – compiles ocaml into js