diff options
Diffstat (limited to 'src/game.ml')
| -rw-r--r-- | src/game.ml | 311 |
1 files changed, 311 insertions, 0 deletions
diff --git a/src/game.ml b/src/game.ml new file mode 100644 index 0000000..f25240f --- /dev/null +++ b/src/game.ml @@ -0,0 +1,311 @@ +exception Rule_error of string + +type lambda = + |Const of int + |Lambda of (lambda -> lambda);; + +let unfold x = match x with + | Lambda y -> y + | _ -> raise( Rule_error "wrong unfolding") + +let id = Lambda(fun x -> x) + +let (@) a1 a2 = unfold a1 a2 + +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 increase card_count = + if !card_count >= 1000 then + raise( Rule_error "apply limit exceeded") + else + card_count:=!card_count+1 + +let zero = Const 0 + +let succ = Lambda(fun a -> increase card_count; + match a with + | Const n -> if n < 65535 then Const (n+1) else Const n + | _ -> raise( Rule_error "not an integer")) + +let dbl = Lambda(fun a -> increase card_count; + match a with + | Const n -> if n < 32768 then Const(2*n) else Const n + | _ -> raise( Rule_error "not an integer")) + +let get = Lambda(fun a -> increase card_count; + 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 -> increase card_count;id) + +let s = Lambda(fun f -> increase card_count;Lambda(fun g -> Lambda(fun x -> (f @ x) @ (g @ x)))) + +let k = Lambda(fun x -> increase card_count;Lambda(fun y -> x)) + +let inc = Lambda(fun a -> increase card_count; + 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 -> increase card_count; + 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 -> increase card_count; + 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 -> increase card_count; + 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 -> increase card_count; + 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 -> increase card_count; + 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 -> increase card_count; + 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 -> increase card_count; + 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 -> increase card_count; + match a with + | Const i -> !opponent.(i).field + | _ -> raise( Rule_error "not an integer")) + +let revive = Lambda(fun a -> increase card_count; + 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 -> increase card_count; + 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 <- + try + (cardfun_of_card card) @ slot.field + with + | Rule_error _ | Invalid_argument _ -> card_count:=0; id + +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 <- + try + slot.field @ (cardfun_of_card card) + with + | Rule_error _ | Invalid_argument _ -> card_count:=0; id + +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 <- + try + slot.field @ (cardfun_of_card_bis card) + with + | Rule_error _ | Invalid_argument _ -> card_count:=0; id + +(* +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;; +*) |