path: root/game.ml

exception Rule_error of string

type lambda =
  |Const of int
  |Lambda of (lambda -> lambda);;

let unfold (Lambda x) = x

let id  = Lambda(fun x -> x)

let (@) a1 a2 = match a1 with
  | Lambda l1 -> l1 a2
  | _ -> raise( Rule_error "wrong application")

type slot = {
    mutable vitality: int;
    mutable field: lambda
}
;;

let player0 = Array.init 256 (fun _ -> {vitality = 10000; field = id})
let player1 = Array.init 256 (fun _ -> {vitality = 10000; field = id})
let card_count = ref(0)
let proponent = ref player0
let opponent = ref player1

let zero = count:=!count+1;Const 0
let succ = Lambda(fun a -> match a with
  |Const n -> if n < 65535 then count:=!count+1; Const (n+1) else count:=!count+1; Const n
  |_ -> raise( Rule_error "not an integer"))
let dbl = Lambda(fun a -> match a with
    |Const n -> if n<32768 then count:=!count+1; Const(2*n) else count:=!count+1; Const n
    |_ -> raise( Rule_error "not an integer"))
let get = Lambda(fun a -> match a with
  |(Const i) -> if !proponent.(i).vitality > 0 then !proponent.(i).field else raise( Rule_error "not a valid slot number")
  |_ ->  raise( Rule_error "not an integer" ))

let put = Lambda(fun x -> id)
let s = Lambda(fun f -> Lambda(fun g -> Lambda(fun x -> (f @ x) @ (g @ x))))
let k = Lambda(fun x -> Lambda(fun y -> x))

let inc = Lambda(fun a -> match a with
  |Const i -> let v = !proponent.(i) .vitality in
	      if ( v < 65535 ) & ( v > 0 ) then
		!proponent.(i).vitality <- v + 1;
	      id
  |_ -> raise( Rule_error "not an integer"))

let inc_bis = Lambda(fun a -> match a with
  |Const i -> let v = !proponent.(i) .vitality in
	      if ( v < 65535 ) & ( v > 0 ) then
		!proponent.(i).vitality <- v - 1;
	      id
  |_ -> raise( Rule_error "not an integer"))


let dec = Lambda(fun a -> match a with 
  | Const i -> let v = !opponent.(255-i).vitality in
	       if v > 0 then
		 !opponent.(255-1).vitality <- v - 1;
	       id
  | _ -> raise( Rule_error "not an integer"))

let dec_bis = Lambda(fun a -> match a with
  | (Const i) -> let v = !opponent.(255-i).vitality in
		 if v > 0 then
		   !opponent.(255-1).vitality <- v + 1;
		 id
  | _ -> raise( Rule_error "not an integer"))

let attack = Lambda(fun a -> Lambda(fun b -> Lambda(fun c -> match a, b, c with
  | Const i, Const j, Const n -> 
    let v = !proponent.(i).vitality in
    if v - n > 0 then
      !proponent.(i).vitality <- v - n
    else
      raise( Rule_error "not enough life left");
    let w = !opponent.(255-j).vitality in
    if w > 0 then
      !opponent.(255-j).vitality <- max 0  (w - 9/10 *n);
    id
  |_ -> raise( Rule_error "not an integer"))))

let attack_bis = Lambda(fun a -> Lambda(fun b -> Lambda(fun c -> match a, b, c with
  | Const i, Const j, Const n ->
    let v = !proponent.(i).vitality in
    if v - n > 0 then
      !proponent.(i).vitality <- v - n
    else
      raise( Rule_error "not enought life left");
    let w = !opponent.(255-j).vitality in
    if w > 0 then
      !opponent.(255-j).vitality <- min 65535  (w + 9/10 *n);
    id
  | _ -> raise( Rule_error "not an integer"))))

let help = Lambda(fun a -> Lambda(fun b -> Lambda(fun c -> match a, b, c with
  | Const i, Const j, Const n ->
    let v = !proponent.(i).vitality in
    if v - n > 0 then
      !proponent.(i).vitality <- v - n
    else
      raise( Rule_error "not enough life left");
    let w = !proponent.(j).vitality in
    if w > 0 then
      !proponent.(j).vitality <- max (w - n*11/10) 0;
    id
  | _ -> raise( Rule_error "not an integer"))))

let help_bis = Lambda(fun a -> Lambda(fun b -> Lambda(fun c -> match a, b, c with
  | Const i, Const j, Const n ->
    let v = !proponent.(i).vitality in
    if v - n > 0 then
      !proponent.(i).vitality <- v - n
    else
      raise( Rule_error "not enough life left");
    let w = !proponent.(j).vitality in
    if w > 0 then
      !proponent.(j).vitality <- min (w + n*11/10) 65535;
    id
  | _ -> raise( Rule_error "not an integer"))))

let copy = Lambda(fun a -> match a with
    | Const i -> !opponent.(i).field
    | _ -> raise( Rule_error "not an integer"))

let revive = Lambda(fun a -> match a with
  | Const i -> let v = !proponent.(i).vitality in
	       if v <= 0 then
		 !proponent.(i).vitality <- 1;
	       id
  | _ -> raise( Rule_error "not an integer"))

let zombie = Lambda(fun a -> match a with
  | Const i -> Lambda(fun x -> 
    let v = !opponent.(255-i).vitality in
    if v <= 0 then
      begin
	!opponent.(255-i).field <- x;
	!opponent.(255-i).vitality <- -1
      end
    else
      raise( Rule_error "slot is alive");
    id)
  |_ -> raise( Rule_error "not an integer"))

type card =
    | I
    | Zero
    | Succ
    | Dbl
    | Get
    | Put
    | S
    | K
    | Inc
    | Dec
    | Attack
    | Help
    | Copy
    | Revive
    | Zombie
;;

let card_of_string s = match s with
    | "I" -> I
    | "zero" -> Zero
    | "Succ" -> Succ
    | "dbl" -> Dbl
    | "get" -> Get
    | "put" -> Put
    | "S" -> S
    | "K" -> K
    | "inc" -> Inc
    | "dec" -> Dec
    | "attack" -> Attack
    | "help" -> Help
    | "copy" -> Copy
    | "revive" -> Revive
    | "zombie" -> Zombie
    | _ -> raise( Rule_error "not a valid card name")
;;

let cardfun_of_card c = match c with
  | I -> id
  | Zero -> zero
  | Succ -> succ
  | Dbl -> dbl
  | Get -> get
  | Put -> put
  | S -> s
  | K -> k
  | Inc -> inc
  | Dec -> dec
  | Attack -> attack
  | Help -> help
  | Copy -> copy
  | Revive -> revive
  | Zombie -> zombie

let cardfun_of_card_bis c = match c with
  | I -> id
  | Zero -> zero
  | Succ -> succ
  | Dbl -> dbl
  | Get -> get
  | Put -> put
  | S -> s
  | K -> k
  | Inc -> inc_bis
  | Dec -> dec_bis
  | Attack -> attack_bis
  | Help -> help_bis
  | Copy -> copy
  | Revive -> revive
  | Zombie -> zombie


let left_apply player card number =
  if player = 0 then begin
    proponent := player0;
    opponent := player1
  end
  else
    begin
      proponent := player1;
      opponent := player0
    end;
  let slot = !proponent.(number) in
  slot.field <- (cardfun_of_card card) @ slot.field

let right_apply player card number =
  if player = 0 then begin
    proponent := player0;
    opponent := player1
  end
  else
    begin
      proponent := player1;
      opponent := player0
    end;
  let slot = !proponent.(number) in
  slot.field <- slot.field @ (cardfun_of_card card)

let right_apply_bis player card number =
  if player = 0 then begin
    proponent := player0;
    opponent := player1
  end
  else
    begin
      proponent := player1;
      opponent := player0
    end;
  let slot = !proponent.(number) in
  slot.field <- slot.field @ (cardfun_of_card_bis card)

(*
right_apply !proponent.(0) Help;;
right_apply !proponent.(0) Zero;;
left_apply K !proponent.(0);;
left_apply S !proponent.(0);;
right_apply !proponent.(0) Succ;;
right_apply !proponent.(0) Zero;;
right_apply !proponent.(1) Zero;;
left_apply Succ !proponent.(1);;
left_apply Dbl !proponent.(1);;
left_apply Dbl !proponent.(1);;
left_apply Dbl !proponent.(1);;
left_apply Dbl !proponent.(1);;
left_apply K !proponent.(0);;
left_apply S !proponent.(0);;
right_apply !proponent.(0) Get;;
left_apply K !proponent.(0);;
left_apply S !proponent.(0);;
right_apply !proponent.(0) Succ;;
right_apply !proponent.(0) Zero;;
*)