Create a gist now

Instantly share code, notes, and snippets.

@mboeh /Makefile
Last active Aug 29, 2015

What would you like to do?
play project with ocaml
run:
ocamlbuild -use-ocamlfind -package batteries world_common.native
ocamlbuild -use-ocamlfind -package batteries world.native && _build/world.native | tee results.txt
upload:
gist -u https://gist.github.com/mboeh/c45e477a8f737a9157e0 world.ml world_common.ml world_common.mli Makefile results.txt
== Tick 0 ==
Randou, age 23 (Quirk: none)
Youngsman, age 19 (Quirk: Benjamin button disease)
Oldsman, age 127 (Quirk: Accelerated aging)
== Tick 4 ==
Randou, age 23 (Quirk: none)
Youngsman, age 15 (Quirk: Benjamin button disease)
Oldsman, age 131 (Quirk: Accelerated aging)
open World_common
open Batteries
module Character_state = struct
open Character
open BatPrintf
type wrapped = Character.t
type t = { character : wrapped ; quirk: Quirk.t }
let make chr = { character = chr ; quirk = Quirk.none }
let create ~name ~age = Character.make ~name ~age |> make
let quirked qk st = { st with quirk = qk }
let tick wld st = { st with character = Quirk.run st.quirk st.character Start_of_turn }
let display st = sprintf "%s (Quirk: %s)" (Character.display st.character) (Quirk.display st.quirk)
end
module Effects = struct
open Effect
open Character
let aging = Effect.make
~name:"Accelerated aging"
~context:Start_of_turn
~action:(fun (c : Character.t) -> { c with age = (Age.change 1 c.age) })
let deaging = Effect.make
~name:"Benjamin button disease"
~context:Start_of_turn
~action:(fun (c : Character.t) -> { c with age = (Age.change (-1) c.age) })
end
(* Represents all the entities in the game world. *)
module World = struct
(* This is a stab at having a polymorphic world entity type. *)
module type World_state = sig
type t
val tick : 'a -> t -> t
val display : t -> string
end
(* I am almost entirely convinced there's some way I can use the type system
* to automatically map Entry.tick to Character_state.tick when t is a Char_entry... *)
module Entry = struct
type t = Char_entry of Character_state.t
let tick wld ent =
match ent with Char_entry ent -> Char_entry (Character_state.tick wld ent)
let display ent =
match ent with Char_entry ent -> Character_state.display ent
end
type t = { entries : Entry.t list ; ticks : int }
(* Create a new world. *)
let make = { entries = [] ; ticks = 0 }
let add wld character = { wld with entries = (Entry.Char_entry character) :: wld.entries }
let make_filled =
let wld = make in
List.fold_left (fun wld st -> add wld st) wld
let tick wld =
let nextworld = (BatList.enum wld.entries) |> Enum.map (Entry.tick wld.entries) |> BatList.of_enum in
{ entries = nextworld ; ticks = wld.ticks+1 }
let iter wld f = List.iter f wld.entries
let print wld =
BatPrintf.printf "== Tick %d ==\n" wld.ticks;
iter wld (fun chr ->
Entry.display chr |> print_string;
print_string "\n"
);
BatPrintf.printf "\n"
end
let mainloop wld =
World.print wld;
World.tick (World.tick (World.tick (World.tick wld)))
let main () =
let characters =
Character_state.([
create ~name:"Oldsman" ~age:127 |> quirked (Quirk.of_effect Effects.aging)
; create ~name:"Youngsman" ~age:19 |> quirked (Quirk.of_effect Effects.deaging)
; create ~name:"Randou" ~age:23
]) in
let wld =
World.make_filled characters in
let final_world =
mainloop wld in
World.print final_world
let () = main ()
module Name = struct
type t = string
let of_string str = str
end
module Age = struct
type t = int
let of_int i = i
let change i age = age + i
end
type effect_context = Start_of_turn | End_of_turn
module Effect = struct
type 'a t = { name: Name.t ; context: effect_context ; action: 'a -> 'a }
type 'a action_f = 'a -> 'a
let make ~name ~context ~action = { name ; context ; action }
let run_for_sure eff tgt = eff.action tgt
let run eff tgt ctx = if eff.context = ctx then run_for_sure eff tgt else tgt
end
module Character = struct
open Printf
type t = { name : Name.t ; age : Age.t }
let make ~name ~age = { name ; age }
let display chr = sprintf "%s, age %d" chr.name chr.age
end
module Quirk = struct
open Effect
open Printf
type qkt = { name : Name.t ; effect : Character.t Effect.t }
type t = qkt option
let none = None
let run qk chr ctx = match qk with Some qk -> Effect.run qk.effect chr ctx | None -> chr
let of_effect (eff : Character.t Effect.t) = Some { name = eff.name ; effect = eff }
let name = function Some qk -> qk.name | None -> "none"
let display qk = sprintf "%s" (name qk)
end
module Name :
sig
type t
val of_string : string -> t
end
module Age :
sig
type t
val of_int : int -> t
val change : int -> t -> t
end
type effect_context = Start_of_turn | End_of_turn
module Effect :
sig
type 'a t
type 'a action_f = 'a -> 'a
val make : name:string -> context:effect_context -> action:('a action_f) -> 'a t
val run : 'a t -> 'a -> effect_context -> 'a
end
module Character :
sig
type t = { name : Name.t ; age : Age.t }
val make : name:string -> age:int -> t
val display : t -> string
end
module Quirk :
sig
type t
val none : t
val run : t -> Character.t -> effect_context -> Character.t
val of_effect : Character.t Effect.t -> t
val name : t -> string
val display : t -> string
end
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment