Drop-down "sig" and "struct" keywords.

[cellular-automata.git] / polymorphism / 001 / src / polymorphism.ml

diff --git a/polymorphism/001/src/polymorphism.ml b/polymorphism/001/src/polymorphism.ml
index 7b48faf..cb9d6a4 100644 (file)
--- a/polymorphism/001/src/polymorphism.ml
+++ b/polymorphism/001/src/polymorphism.ml
@@ -4,7 +4,8 @@ open Core.Std
 let (|-) g f x = f (g x)
 
 
-module Terminal : sig
+module Terminal :
+sig
   type color = [ `green
                | `red
                | `white
@@ -15,7 +16,8 @@ module Terminal : sig
   val clear : unit -> unit
 
   val reset : unit -> unit
-end = struct
+end =
+struct
   type color = [ `green
                | `red
                | `white
@@ -40,8 +42,10 @@ end = struct
 end
 
 
-module type MATRIX = sig
-  module Point : sig
+module Matrix :
+sig
+  module Point :
+  sig
     type t = {r : int; k : int}
   end
 
@@ -58,10 +62,10 @@ module type MATRIX = sig
   val iter : 'a t -> f:(Point.t -> 'a -> unit) -> unit
 
   val print : 'a t -> to_string:('a -> string) -> unit
-end
-
-module Matrix : MATRIX = struct
-  module Point = struct
+end =
+struct
+  module Point =
+  struct
     type t = {r : int; k : int}
 
     let (+) p p' =
@@ -70,7 +74,8 @@ module Matrix : MATRIX = struct
       }
   end
 
-  module Direction = struct
+  module Direction =
+  struct
     type t = NW | N | NE
            | W  |     E
            | SW | S | SE
@@ -146,13 +151,15 @@ module Matrix : MATRIX = struct
 end
 
 
-module PhenoType : sig
+module PhenoType :
+sig
   type t
 
   val create : char -> Terminal.color option -> t
 
   val to_string : t -> string
-end = struct
+end =
+struct
   type t = { color     : Terminal.color option
            ; character : char
            }
@@ -168,9 +175,15 @@ end = struct
 end
 
 
-module Cell = struct
-  module State = struct
-    type t = Alive of char
+module Cell =
+struct
+  module State =
+  struct
+    type intention = Friendly
+                   | Neutral
+                   | Hostile
+
+    type t = Alive of intention
            | Dead
   end
 
@@ -180,7 +193,8 @@ module Cell = struct
 end
 
 
-module type RULE = sig
+module type RULE =
+sig
   val create : unit -> Cell.t
 
   val transition : self:Cell.State.t
@@ -189,8 +203,10 @@ module type RULE = sig
 end
 
 
-module Life : RULE = struct
-  module State : sig
+module Life : RULE =
+struct
+  module State :
+  sig
     type t = D | A
 
     val of_int : int -> t
@@ -200,7 +216,8 @@ module Life : RULE = struct
     val to_cell : t -> Cell.t
 
     val of_cell_state : Cell.State.t -> t
-  end = struct
+  end =
+  struct
     type t = D | A
 
     let of_int = function
@@ -217,13 +234,14 @@ module Life : RULE = struct
       | A -> PhenoType.create 'o' (Some `white)
 
     let of_cell_state = function
-      | Cell.State.Dead      -> D
-      | Cell.State.Alive 'A' -> A
-      | Cell.State.Alive _   -> D  (* Foreign cell *)
+      | Cell.State.Dead                      -> D
+      | Cell.State.Alive Cell.State.Friendly -> A
+      | Cell.State.Alive Cell.State.Neutral  -> A
+      | Cell.State.Alive Cell.State.Hostile  -> D
 
     let to_cell_state = function
       | D -> Cell.State.Dead
-      | A -> Cell.State.Alive 'A'
+      | A -> Cell.State.Alive Cell.State.Neutral
 
     let to_cell t =
       { Cell.state = t |> to_cell_state
@@ -254,8 +272,10 @@ module Life : RULE = struct
 end
 
 
-module ForestFire : RULE = struct
-  module State : sig
+module ForestFire : RULE =
+struct
+  module State :
+  sig
     type t = E | T | B
 
     val is_burning : t -> bool
@@ -267,7 +287,8 @@ module ForestFire : RULE = struct
     val to_cell : t -> Cell.t
 
     val of_cell_state : Cell.State.t -> t
-  end = struct
+  end =
+  struct
     type t = E | T | B
 
     let is_burning = function
@@ -292,15 +313,15 @@ module ForestFire : RULE = struct
       | B -> PhenoType.create '#' (Some `red)
 
     let of_cell_state = function
-      | Cell.State.Dead      -> E
-      | Cell.State.Alive 'T' -> T
-      | Cell.State.Alive 'B' -> B
-      | Cell.State.Alive _   -> E  (* Foreign cell *)
+      | Cell.State.Dead                      -> E
+      | Cell.State.Alive Cell.State.Friendly -> T
+      | Cell.State.Alive Cell.State.Neutral  -> E
+      | Cell.State.Alive Cell.State.Hostile  -> B
 
     let to_cell_state = function
       | E -> Cell.State.Dead
-      | T -> Cell.State.Alive 'T'
-      | B -> Cell.State.Alive 'B'
+      | T -> Cell.State.Alive Cell.State.Friendly
+      | B -> Cell.State.Alive Cell.State.Hostile
 
     let to_cell t =
       { Cell.state = t |> to_cell_state
@@ -339,7 +360,8 @@ module ForestFire : RULE = struct
 end
 
 
-module Automaton : sig
+module Automaton :
+sig
   type t
 
   val create  : rows:int
@@ -349,7 +371,8 @@ module Automaton : sig
              -> t
 
   val loop : t -> unit
-end = struct
+end =
+struct
   type cell = { data : Cell.t
               ; rule : (module RULE)
               }
@@ -406,10 +429,9 @@ end = struct
 end
 
 
-let main () =
+let main interval () =
   Random.self_init ();
   let rows, columns = Or_error.ok_exn Linux_ext.get_terminal_size () in
-  let interval = 0.1 in
   let rules =
     [ (module Life : RULE)
     ; (module ForestFire : RULE)
@@ -420,7 +442,11 @@ let main () =
 
 let spec =
   let summary = "Polymorphic Cellular Automata" in
-  let spec = Command.Spec.empty in
+  let spec = Command.Spec.(empty
+    +> flag "-i" (optional_with_default 0.1 float)
+             ~doc:" Induced interval between generations."
+    )
+  in
   Command.basic ~summary spec main