let instants = 500  // maximum number of instants fo the simulation
let delay = 1000    // number of cycles run at each instant by each living cells

/*****************************************************************/
let s1 = scheduler  // two synchronised schedulers
and s2 = scheduler  // sharing the same instants

/*****************************************************************/
// the type of colors; each color is a constructor without argument
type color = 
   BLUE | GREEN | YELLOW | RED | CYAN | BLACK | MAGENTA | GRAY25

/*****************************************************************/
// declaration of some interface functions (implemented in C)
let get_maxx           : unit -> int
let get_maxy           : unit -> int
let start_graphics     : unit -> bool // true = ok
let update_display     : unit -> unit
let draw_rectangle : 
    int // x
  * int // y
  * int // size
  * color -> bool

/***********************************************/
// GRAPHICS
/***********************************************/
let maxx = get_maxx ()  // x size of the graphical applet
let maxy = get_maxy ()  // y size of the graphical applet

/***********************************************/
// the module that initialises the display and updates it at each instant
let module update () =
   begin
      if not (start_graphics ()) then
         begin
           print_string ("can't initialize display\n");
           quit (1) // terminate the simulation
         end
      end;
      loop begin
         update_display ();
         cooperate
      end
  end

/***********************************************/
// the type of areas which are images of cells
type area = Area of 
    int // x
  * int // y
  * int //size
  * color 

// drawing an area
let draw_area (a) = 
  match a with Area (x,y,s,c) -> draw_rectangle (x,y,s,c) end

let draw_event = event // the event that collect areas to be drawn

// at each instant, draw areas for all values of the event draw_event
let module draw_processor () =
   loop for_all_values draw_event with a -> draw_area (a)

/*****************************************************/
// MAPS
/******************************************************/
// the array of cell activation events (initially, a null event)
let null_event = event
let event_map = ref [maxx] ref [maxy] null_event

// the array of cell states (living or dead; initially dead)
let state_map = ref [maxx] ref [maxy] ref false

/*****************************************************************/
// CELL DISPLAY
/*****************************************************************/
// function that displays a cell (BLACK when dead, color when alive)

let cell_display (x,y,living,color) =
   if not living then generate draw_event with Area (x,y,1,BLACK)
   else generate draw_event with Area (x,y,1,color)

/*****************************************************************/
// GOL STRATEGY
/*****************************************************************/
// the Game of Life basic function that defines birth and death of cells

let gol_strategy (living,neighbour) =
   if (not !living) && neighbour = 3 then living := true else 
   if !living && neighbour <> 2 && neighbour <> 3 then living := false 
   else ()

/*****************************************************************/
// NEIGHBOURS
/*****************************************************************/
/* toric geometry (immediate as access to an array element is 
modulo the array size, so there is no possibility of 
out-of-bound error) */

let event_at (x,y) = !(!event_map [x]) [y]

// list of activation events of the 8 neighbour cells
let get_neighbours (x,y) =
     Cons_list (event_at (x,y-1),
     Cons_list (event_at (x+1,y-1),
     Cons_list (event_at (x+1,y),
     Cons_list (event_at (x+1,y+1),
     Cons_list (event_at (x,y+1),
     Cons_list (event_at (x-1,y+1),
     Cons_list (event_at (x-1,y),
     Cons_list (event_at (x-1,y-1),Nil_list))))))))

// activate the neighbours
let awake (neighbours) =
   match neighbours with Nil_list -> () 
   | Cons_list (head,tail) -> 
          begin generate head; awake (tail) end
   end

/*****************************************************************/
// CELLS
/*****************************************************************/
// two events to synchronise the start of all cells
let ready = event
let starting_event = event

// the module that defines the cell behaviour
let module linked_cell (x,y,me,state,color,neighbours) =
let count = ref 0 in
let living = ref state in
begin
  generate ready;
  await starting_event;
  loop begin
    cell_display (x,y,!living,color);
    if !living then 
      awake (neighbours)
    else 
      await me; // just wait to be activated (passive waiting)
    count := 0;
    for_all_values me with _ -> count++; // get the number of living neighbours
    gol_strategy (living,!count); // apply the game of life strategy
    repeat delay do count++ // waste some computing resource...
  end
end

/* the basic cell module; first, get the activation event of the cell,
the initial state, and the neighbours; then, link to the
appropriate scheduler and launch an instance of linked_cell in it.
*/

let module cell (k,x,y,color) = 
  let me = !(!event_map[x])[y] in
  let state = !(!(!state_map[x])[y]) in
  let neighbours = get_neighbours (x,y) in
    if k=1 then  
       link s1 do
          thread linked_cell (x,y,me,state,color,neighbours)
    else
       link s2 do
          thread linked_cell (x,y,me,state,color,neighbours)

/*****************************************************/
// INITIAL SHAPE
/******************************************************/
// sets as alive a cell given by its coordinates x and y
let fire (x,y) =
    let state = !(!state_map [x]) [y] in state := true

/****************************************************/
// the initial shape (called pentomino) placed at coordinates x,y
let r_pentomino_shape (x,y) =
 begin
   fire (x,y);
   fire (x+1,y);
   fire (x+1,y-1);
   fire (x+1,y+1);
   fire (x+2,y-1)
 end

/****************************************************/
// SLICES
/****************************************************/
// the function that creates cells in a slice, with appropriate color
let slice (n,inity,endy) =
  let y = ref inity in
  repeat endy-inity do begin
      let x = ref 0 in
      repeat maxx do begin
       if n = 1 then thread cell (1,!x,!y,GREEN) 
       else thread cell (2,!x,!y,RED);
       x++
     end;
     y++
   end

/****************************************************/
// CONTROL OF THE SIMULATION
/****************************************************/
// module to trace instants and to end the simulation
let module ctrl (n) =
 let c = ref 0 in
   begin
       await starting_event;
       print_string ("start simulation\n");
       repeat n do begin
          print_int (!c); c++; print_string (" "); flush ();
          cooperate;
       end;
       print_string ("end simulation\n");
       quit (0);
   end

/****************************************************/
// MAP INITIALISATION
/****************************************************/
// creation of the event map; a new fresh event for each cell
let create_event_map () =
  let y = ref 0 in
   repeat maxy do 
   begin
     let x = ref 0 in
     repeat maxx do begin
        (!event_map[!x])[!y] := event;
        x++;
     end;
     y++
   end

// creation of the state map; each cell is initially dead
let create_state_map () =
  let y = ref 0 in
   repeat maxy do 
   begin
     let x = ref 0 in
     repeat maxx do begin
        !(!state_map[!x])[!y] := false;
        x++;
     end;
     y++
   end

/****************************************************/
// INITIAL SYNCHRONISATION
/****************************************************/
/* waits for all cells to be ready (there are maxx*maxy cells) 
and starts them by generating the event starting_event (events are
broadcast in s1 and s2, so all cells receive it; moreover, they all
receive it at the same instant) */

let module starter () =
   let n = maxx*maxy in
   let count = ref 0 in
   begin
      while !count < n do
         for_all_values ready with _ -> count++;
      generate starting_event; // go!
   end

/****************************************************/
// MAIN
/****************************************************/
// the main entry point (the initial thread)

let module main () = 
  begin
    create_event_map ();
    create_state_map ();
    // put the pentomino in the middle of the applet
    r_pentomino_shape (maxx/2,maxy/2);

    slice (1,0,maxy/2);      // top slice of cells run by s1
    slice (2,1+maxy/2,maxy); // bottom slice of cells run by s2

    link s1 do begin // arbitrary choice of s1 (could be s2 as well)
       thread ctrl (instants);
       thread update (); 
       thread draw_processor (); 
       thread starter ();
    end
  end

/****************************************************/