Cellular automaton.ml

(* 
    Cellular automaton
    Copyright (C) 2013  Thibault 'Dethi' Deutsch <thibault.deutsch@epita.fr>

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*)


#load "graphics.cma";;
open Graphics;;
open Random;;
self_init ();;


(*  ==========
    CONSTANTES 
    ========== *)

let grey = rgb 127 127 127;;
let new_cell = 1;;
let empty = 0;;
let size_cell = 10;;


(*  =====================
    OPERATIONS SUR LISTES
    ===================== *)

let rec iter (f) = function
      []    -> ()
    | e::l  -> f e; iter f l;;

let rec map (f) = function
      []    -> []
    | e::l  -> (f e):: map f l;;

let iteri (f) lst =
    let rec print f i = function
          []    -> ()
        | e::l  -> f i e; print f (i+1) l
    in
        print f 0 lst;;

let mapi (f) lst =
    let rec apply f i = function
          []    -> []
        | e::l  -> (f i e):: apply f (i+1) l
    in
        apply f 0 lst;;

let rec for_all (p) = function
      [] -> true
    | e::l -> (p e) && for_all p l;;

let rec exists (p) = function
      [] -> false
    | e::l -> (p e) || exists p l;;

let remaining (p) board =
    exists (exists (p)) board;;

let map_board board (f) =
    map (map (function e -> if e > 0 then f e else e)) board;;


(*  ================
    FONCTIONS DU JEU 
    ================ *)

let is_alive = function
      1 -> true
    | _ -> false;;

let put_cell cell (x, y) board =
    let rec put x = function
          []                -> []
        | _::l when x = 0   -> cell::l
        | e::l              -> e:: put (x-1) l
    and goto_lines y = function
          []                -> []
        | e::l when y = 0   -> (put x e)::l
        | e::l              -> e:: goto_lines (y-1) l
    in
        if (x >= 0) && (y >= 0) then
            goto_lines y board
        else
            board;;

let count_neighbours x y board =
    let rec get_x acc y = function
          []    -> 0
        | e::l  ->
            begin
                match acc with
                      (-1)  -> e
                    | 0     -> (if y = 0 then 0 else e) + get_x (acc-1) y l
                    | 1     -> e + get_x (acc-1) y l
                    | _     -> get_x (acc-1) y l
            end
    and get_y acc = function
          []    -> 0
        | e::l  ->
            begin
                match acc with
                      (-1)  -> get_x x acc e
                    | 0 | 1 -> (get_x x acc e) + (get_y (acc-1) l)
                    | _     -> get_y (acc-1) l
            end
    in
        get_y y board;;

let gen_board n value =
    let rec gen_list value = function
          0 -> []
        | n -> value:: gen_list value (n-1)
    in
        if n > 0 then
            gen_list (gen_list value n) n
        else
            [];;

let seed_life board size count = 
    let rec f board = function
          0 -> board
        | n -> f (put_cell new_cell ((int size)+1 , (int size)+1) board) (n-1)
    in
        if count < 0 then
            board
        else
            f board count;;

let new_board size init_cell =
    seed_life (gen_board size empty) size init_cell;;

let init_pattern pattern size = 
    let rec f board = function
          []    -> board
        | e::l  -> f (put_cell new_cell e board) l
    in
        f (gen_board size empty) pattern;;

let mapi_board board (count_neighbours) (rules) =
    mapi (function y -> function lst -> mapi (function x -> function cell -> rules cell (count_neighbours x y board)) lst) board;;


(*  ================
    PARTIE GRAPHIQUE
    ================ *)

let open_windows size = open_graph (string_of_int (size+20) ^ "x" ^ string_of_int (size+40)); clear_graph ();;

(* version pour mac/linux :
   ========================

let open_windows size =
    open_graph "";
    resize_window size size;
    clear_graph ();; *)

let draw_cell cell (x ,y) size_cell (cell_color) =
    set_color (cell_color cell); fill_rect (x*size_cell) (y*size_cell) size_cell size_cell;
    set_color grey; draw_rect (x*size_cell) (y*size_cell) size_cell size_cell;;

let draw_board board size_cell (cell_color) =
    iteri (function y -> function lst -> iteri (function x -> function cell -> draw_cell cell (x, y) size_cell (cell_color)) lst) board;;


(*  ======================
    DIFFERENTS MODE DE JEU 
    ====================== *)

(* Game of Life *)
let rules cell = function
      2 -> cell
    | 3 -> new_cell
    | _ -> empty;;

let cell_color = function
      0 -> white
    | _ -> black;;

(* Day & Night *)
let day_night_rules cell voisine = match (cell, voisine) with
      (1, (3 | 4 | 6 | 7 | 8)) -> new_cell
    | (0, (3 | 6 | 7 | 8)) -> new_cell
    | _ -> empty;;

let day_night_cell_color = function
      0 -> black
    | _ -> yellow;;

(* HighLife *)
let highlife_rules cell = function
      2 -> cell
    | 3 -> new_cell
    | 6 ->
        begin
            if (is_alive cell) then empty
                else new_cell
        end
    | _ -> empty;;

let highlife_cell_color = function
      0 -> white
    | _ -> blue;;


(*  =======
    PATTERN
    ======= *)

(* Le canon à planeurs *)
let canon =  
[(1, 44); (1, 45); (2, 44); (2, 45); (13, 41); (14, 41); (12, 42); (11, 43);
 (11, 44); (11, 45); (12, 46); (13, 47); (14, 47); (15, 44); (16, 42);
 (16, 46); (17, 45); (17, 44); (17, 43); (18, 44); (21, 45); (21, 46);
 (21, 47); (22, 45); (22, 46); (22, 47); (23, 44); (23, 48); (25, 43);
 (25, 44); (25, 48); (25, 49); (35, 46); (35, 47); (36, 46); (36, 47)];;
let board_canon = init_pattern canon 50;;

(* Le clown *)
let clown = [(20,17);(19,15);(19,16);(19,17);(21,15);(21,16);(21,17)];;
let board_clown= init_pattern clown 40;;


(*  ===================
    LANCEURS DE PARTIES
    =================== *)

(* mode Game of Life qui s'arrête quand toutes les cellules sont mortes *)
let game_of_life size size_cell =
    open_windows (size*size_cell);
    let board = new_board size (size*(size-3))
    in
        let rec infinit_game board =
            draw_board board size_cell (cell_color);
            if (remaining (is_alive) board) then
                infinit_game (mapi_board board (count_neighbours) (rules))
        in
            infinit_game board;;

(* tout les modes possibles *)
let real_life size size_cell init_cell (cell_color) (rules) =
    open_windows (size*size_cell);
    let board = new_board size init_cell
    in
        let rec infinit_game board =
            draw_board board size_cell (cell_color);
            if (remaining (is_alive) board) then
                infinit_game (mapi_board board (count_neighbours) (rules))
        in
            infinit_game board;;

(* mode pattern et Game of Life qui s'arrête après n générations *)
let new_game board size size_cell gen =
    open_windows (size * size_cell);
    if gen <> 0 then
        let rec game board = function
              0 -> ()
            | n -> draw_board board size_cell (cell_color);
                   game (mapi_board board (count_neighbours) (rules)) (n-1)
        in
            if gen > 0 then
                game board (gen+1)
            else
                ()
    else
        let rec infinit_game board =
            draw_board board size_cell (cell_color);
            if (remaining (is_alive) board) then
                infinit_game (mapi_board board (count_neighbours) (rules))
        in
            infinit_game board;;


(*  ===========
    MENU DU JEU
    =========== *)

let menu =
    print_endline "Automate cellulaire\n===================\n";
    print_endline "1. Game of Life\n2. Day and Night\n3. HighLife";
    print_string  "Votre choix : ";
    let input = read_int ()
        in if input = 1 then
            begin
                print_newline ();
                print_endline "1. Aleatoire\n2. Clown\n3. Canon a planeurs\n";
                print_string "Votre choix : ";
                let input = read_int ()
                    in match input with
                        1 ->
                            begin
                                print_string "Nombre de cellules ? "; let nb_cell = read_int ()
                                    in print_string "Nombre de generation ? "; let gen = read_int ()
                                        in let board = new_board 50 nb_cell
                                            in new_game board 50 size_cell gen
                            end
                        | 2 -> new_game board_clown 40 size_cell 110
                        | 3 ->
                            begin
                                print_string "Nombre de generation ? "; let gen = read_int ()
                                    in new_game board_canon 50 size_cell gen
                            end
                        | _ -> invalid_arg "Ce chiffre ne correspond a aucune entree du menu."
            end
        else
            if input = 2 then
                real_life 50 size_cell (50*30) (day_night_cell_color) (day_night_rules)
            else
                real_life 50 size_cell (50*30) (highlife_cell_color) (highlife_rules);;

read_key ();; (* bloque la fermeture de la fenêtre *)

Pas mal !