Created
August 9, 2015 02:57
-
-
Save ImaginaryDevelopment/3eb7389b5e3f7e22f4cb to your computer and use it in GitHub Desktop.
Catan modeling
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
//catan | |
// github.com/MichaelLPerry/dof | |
type Hand = { Wood: byte; Wheat: byte; Sheep: byte; Stone: byte; Gold:byte} with | |
member x.Values = [x.Wood; x.Wheat; x.Sheep; x.Stone; x.Gold] | |
member x.IsValid = x.Values |> Seq.forall ((>=) 0uy) | |
member x.HasAtLeast (resources:Hand) = | |
let calculated = x.Values |> Seq.map2 (<=) resources.Values | |
calculated |> Seq.forall id | |
static member Zero = {Wood = 0uy; Wheat = 0uy; Sheep = 0uy; Stone = 0uy; Gold = 0uy} | |
static member (-) (f1 : Hand, f2 : Hand) = | |
let takeRes errorMsg x1 x2 = if x1 < x2 then failwith errorMsg else x1 - x2 | |
//let wheat = if f1.Wheat < f2.Wheat then failwithf "Not enough wheat. Go get a combine" else f1.Wheat - f2.Wheat | |
let wood = takeRes "Not enough wood. Try again in the morning" f1.Wood f2.Wood | |
let wheat = takeRes "Not enough wheat." f1.Wheat f2.Wheat | |
let sheep = takeRes "Not enough Sheep" f1.Sheep f2.Sheep | |
let stone = takeRes "Not enough stone" f1.Stone f2.Stone | |
let gold = takeRes "Not enough gold" f1.Gold f2.Gold | |
{Wood = wood; Wheat = wheat; Sheep = sheep; Stone = stone; Gold = gold} | |
static member (+) (f1,f2) = {Wood= f1.Wood + f2.Wood; Wheat = f1.Wheat + f2.Wheat; Sheep = f1.Sheep + f2.Sheep; Stone = f1.Stone + f2.Stone;Gold = f1.Gold + f2.Gold} | |
module Tests = | |
let hand = {Wood=1uy; Wheat =0uy; Sheep= 0uy; Stone = 0uy; Gold = 0uy} | |
let test1 ()= hand.HasAtLeast {Wood = 1uy; Wheat = 0uy;Stone = 0uy; Gold= 0uy; Sheep = 0uy} | |
let test2 () = hand.HasAtLeast {Wood = 1uy; Wheat = 0uy;Stone = 0uy; Gold= 0uy; Sheep = 1uy} | |
type State = { Players: (string*Hand) seq | |
//Player1:Hand option; Player2: Hand option; Player3: Hand option; Player4: Hand option | |
} //with | |
//static member Initial = {Room="start"; Xp=0; Level =1; X=0; Y=0;Health = 4<Health>; MoveCount =0; Monster = None; Damage = Die.D4} | |
type Player = string | |
type Give = Player*Hand | |
type Take = Hand * Player | |
type Command = | |
|Trade of (Give) * (Take) //proposed state | |
|Build | |
|Develop | |
|EndTurn | |
|Load of State // load a saved game | |
type Reply = | |
| TradeSuccess | |
| Msg of string | |
| Death of string | |
| Exception of Command * System.Exception | |
type Message = Command*State*AsyncReplyChannel<Reply*State> | |
let processCommand cmd (initialState:State) = | |
let replyCant () = Msg "I'm afraid I can't let you go that way dave" | |
match cmd with | |
| Trade (give,take) -> | |
let giver,give = give | |
let take,taker = take | |
let giverHand = initialState.Players |> Seq.find(fun (p,_) -> giver = p) |> snd | |
let takerHand = initialState.Players |> Seq.find(fun (p,_) -> taker = p) |> snd | |
match giverHand.HasAtLeast give, takerHand.HasAtLeast take with | |
| true,true -> Reply.TradeSuccess, {Players = initialState.Players |> Seq.map(fun (p,hand) -> p, if p= giver then hand + take - give elif p = taker then hand + give - take else hand) } | |
| false,true -> Msg "Giver didn't have enough resources",initialState | |
| true,false -> Msg "Taker didn't have enough resources",initialState | |
let mailbox = | |
let processor = new MailboxProcessor<Message>(fun inbox -> | |
let rec loop() = | |
async{ | |
let! message = inbox.Receive() | |
let cmd, initialState, replyChannel = message | |
let reply,state = | |
try | |
processCommand cmd initialState | |
with ex -> Exception(cmd,ex), initialState | |
replyChannel.Reply (reply,state) | |
do! loop() | |
} | |
loop()) | |
processor.Start() | |
processor |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment