Source

Caml / TPObjet / living.ml

class entity name start_x start_y col =
object (self)
  val mutable x:int = start_x
  val mutable y:int = start_y
  val mutable color = col

  (* return position in form of a pair of int *)
  method get_position = (x,y)

  (* set position to nx ny *)
  method move_to nx ny =
    begin
      x <- nx;
      y <- ny
    end

  (* move using a delta (use move_to) *)
  method move_by dx dy =
    self#move_to (x+dx) (y+dy)

  (* get and set color *)
  method get_color = color
  method set_color c = 
    color <- c

  (* get name *)
  method get_name = name

  (* return a string representing the entity *)
  method to_string =
    Printf.sprintf "%s[%s](%d,%d)" name color x y

end


class ['obj] print_helper =
object (self)
  (* JEDI MODE: you don't see the next line *)
  val mutable obj:'obj = Obj.magic None
  method register o = obj <- o
  method print =
    Format.printf "@[<b 2>Entity:@;@[<h>%s@]@]@," obj#to_string

end

class printable_entity name start_x start_y col =
object (self)

  (* inherit from entity *)
  inherit entity name start_x start_y col

  (* add a printer *)
  val printer = new print_helper

  (* Use printer to print *)
  method print = printer#print

  initializer
    (* Register to the printer *)
    printer#register self

end

class virtual ['a] virtual_board =
object
  method virtual put_entity: int -> int -> 'a -> unit
  method virtual get_entity: int -> int -> 'a
  method virtual move_entity: int -> int -> int -> int -> unit
end

exception Cell_not_empty of int*int
exception Cell_empty of int*int

(* 'a: will be the type of element on the board *)
class ['a] board size_x size_y =
object (self)
  inherit ['a] virtual_board

  val tab = Array.make_matrix size_x size_y None

  (* put an entity at (x,y) *)
  (* raise Cell_not_empty if needed *)
  method put_entity x y (ent:'a) =
    begin
      if tab.(x).(y) = None then tab.(x).(y) <- Some ent else raise (Cell_not_empty (x,y))
    end

  (* return the entity at (x,y) *)
  (* raise Cell_empty if needed *)
  method get_entity x y =
    match (tab.(x).(y)) with
      | None -> raise (Cell_empty (x,y))
      | Some ent -> ent

  (* move some entity from pos to pos *)
  method move_entity old_x old_y x y =
    begin
      self#put_entity x y (self#get_entity old_x old_y);
      (* Thanks to exception, we only get there if everything is fine *)
      tab.(old_x).(old_y) <- None;
    end

end

class move_entity name start_x start_y col (board:'a) =
object (self:'self)
  inherit entity name start_x start_y col as ent

         constraint 'a = 'self #virtual_board

  method move_to nx ny =
    begin
      board#move_entity x y nx ny;
      ent#move_to nx ny;
    end

  initializer
    board#put_entity start_x start_y self

end

class ['ae] fight_entity name start_x start_y col board strength resistance =
object (self)
  inherit move_entity name start_x start_y col board as m_ent

  (* get strength and resistance *)
  method get_strength:int = strength
  method get_resistance:int = resistance

  (* defense against ae, another-entity *)
  method defense (ae:'ae) =
    if resistance < ae#get_strength then self#set_color(ae#get_color)

  (* atack *)
  method attack (ae:'ae) = 
    ae#defense self

  (* Override move_to *)
  method move_to nx ny =
    try
      m_ent#move_to nx ny
    with
      | Cell_not_empty _ -> self#attack (board#get_entity nx ny)

end

class ['a, 'b] iterable_board (board:'a virtual_board) =
object (self)

  inherit ['a] virtual_board

  (* Forwarded methods *)
  method get_entity x y = board#get_entity x y
  method move_entity old_x old_y x y = board#move_entity old_x old_y x y

  (* add some store for entities, like a list *)
  val mutable entities = []

  (* forward put_entity to the board and then (if nothing goes wrong)
   add it to the store *)
  method put_entity x y ent = 
    board#put_entity x y ent;
    entities <- ent::entities

  (* iterate over each entity e and call actor#treat e *) 
  method iterate (actor:'b) = 
    List.iter (function e -> actor#treat e) entities

end

class virtual ['a] abstract_actor =
object
  method virtual treat : 'a -> unit
end

class ['a] basic_random_move_actor range_x range_y range_dist =
object
  inherit ['a] abstract_actor

  method treat e =
    let (x, y) = e#get_position in
    let sign = if Random.bool() then 1. else -1. in
    let dist = float_of_int(Random.int (range_dist + 1)) in
    let coef = Random.float 1. in
    let (cx,cy) = (coef, 1.-.coef) in
    let d = sqrt ((dist*.dist)/.(cx*.cx+.cy*.cy)) in
    let (dx,dy) = (sign*.cx*.d,sign*.cy*.d) in
    let (nx,ny) = (max 0 (min(range_x-1) (int_of_float(dx)+x)), max 0 (min (range_y-1) (int_of_float(dy) + y))) in
      e#move_to nx ny
end

class ['a, 'b] chain_actor =
object
  inherit ['a] abstract_actor
  constraint 'b = 'a #abstract_actor
  val actors = Queue.create ()
  method register(a:'b)=Queue.push a actors
  method treat e = Queue.iter (fun a -> a#treat e) actors
end
exception The_End
class virtual ['a] abstract_master (turns:int) (board:'a) =
object (self)
  val mutable current = 0
  (* Actor management *)
  val actors = new chain_actor
  method register_actor a = actors#register a
  (* virtual display *)
  method virtual display : unit
  (* virtual init *)
  method virtual init_board : unit
  method next_turn =
    begin
      current <- current + 1;
      if current > turns then raise The_End;
      board#iterate actors;
      self#display
    end
end

class team board color attcoef =
object (self)
  val mutable members = 0
  val defcoef = 100 - attcoef
  (* Create a new entity *)
  method new_member x y = 
    let base = (Random.int 10) * 10 + Random.int 10 in
    let name = Printf.sprintf "%s%02d" color members in
    let (strength, resistance) = (attcoef * base, defcoef * base) in
      begin
        members <- members + 1;
        new fight_entity name x y color board strength resistance;
      end
end

class virtual ['a] team_master turns board size_x size_y =
object (self)
  inherit ['a] abstract_master turns board
  val red_team = new team board "red" 60
  val blue_team = new team board "blue" 40
  val green_team = new team board "green" 50
  val teams = Array.create 3 (Obj.magic None)
  initializer                 teams.(0) <- red_team;
                              teams.(1) <- green_team;
                              teams.(2) <- blue_team;
  method init_board =
    for x = 0 to size_x - 1 do
      for y = 0 to size_y - 1 do
        let rand = Random.int 3 in
          if Random.int 100 > 80
          then
            match rand with
              |1 -> board#put_entity x y (red_team#new_member x y)
              |2 -> board#put_entity x y (blue_team#new_member x y)
              |_ -> board#put_entity x y (green_team#new_member x y)
      done
    done
end

class ['a] text_master turns board size_x size_y colors =
object (self)
  inherit ['a] team_master turns board size_x size_y
  val tab = Hashtbl.create 11
  initializer
    List.iter (fun (col,ch) -> Hashtbl.add tab col ch) colors
  (* Get the char for a color using Hashtbl.find tab color *)
  method display =
    for i = 1 to size_y do
        Printf.printf "---------------------\n";
          for j = 1 to size_x do
            Printf.printf "|";
            Printf.printf "%c" (Hashtbl.find tab (board#get_entity i j)#get_color);
          done;
        Printf.printf "|\n"
    done
end


let rec until_the_end master =
  try
    master#next_turn;
    until_the_end master
  with
      The_End -> ()

let main () =
  begin
    let (dX, dY) = (10, 10) in
    let board = new iterable_board (new board dX dY) in
    let master = new text_master 10 board dX dY [("red",'R');("green", 'G');("blue",'B')] in
      master#register_actor (new basic_random_move_actor dX dY 5);
      master#init_board;
      master#display;
      until_the_end master;
      exit 0
  end

  let _ = main ()