diff --git a/Game.fs b/Game.fs index 301d24f..5b9d3c3 100644 --- a/Game.fs +++ b/Game.fs @@ -1,124 +1,147 @@ // // --------- Model --------- // - type Details = - { Name: string - Description: string } + { Name : string + Description : string } type Item = - { Details: Details } + { Details : Details } -type RoomId = - | RoomId of string +type RoomId = RoomId of string type Exit = - | PassableExit of string * destination: RoomId - | LockedExit of string * key: Item * next: Exit + | PassableExit of string * destination : RoomId + | LockedExit of string * key : Item * next : Exit | NoExit of string option type Exits = - { North: Exit - South: Exit - East: Exit - West: Exit } + { North : Exit + South : Exit + East : Exit + West : Exit } type Room = - { Id: RoomId - Details: Details - Items: Item list - Exits: Exits } + { Id : RoomId + Details : Details + Items : Item list + Exits : Exits } type Player = - { Details: Details - Location: RoomId - Inventory: Item list } + { Details : Details + Location : RoomId + Inventory : Item list } type World = - { Rooms: Map - Player: Player } + { Rooms : Map + Player : Player } // --------- Initial World --------- - -let key: Item = +let key : Item = { Details = { Name = "A shiny key" - Description = "This key looks like it could open a nearby door."} } - -let allRooms = [ - - { Id = RoomId "center" - Details = - { Name = "A central room" - Description = "You are standing in a central room with exits in all directions. A single brazier lights the room."} - Items = [] - Exits = - { North = PassableExit ("You see a darkened passageway to the north.", RoomId "north1") - South = PassableExit ("You see door to the south. A waft of cold air hits your face.", RoomId "south1") - East = LockedExit ("You see a locked door to the east.", key, PassableExit ("You see an open door to the east.", RoomId "east1")) - West = PassableExit ("You see an interesting room to the west.", RoomId "west1") }} - - { Id = RoomId "north1" - Details = - { Name = "A dark room" - Description = "You are standing in a very dark room. You hear the faint sound of rats scurrying along the floor."} - Items = [] - Exits = - { North = NoExit None - South = PassableExit ("You see an dimly lit room to the south.", RoomId "center") - East = NoExit None - West = NoExit None }} - - { Id = RoomId "south1" - Details = - { Name = "A cold room" - Description = "You are standing in a room that feels very cold. Your breath instantly turns into a white puff."} - Items = [] - Exits = - { North = PassableExit ("You see an exit to the north. That room looks much warmer.", RoomId "center") - South = NoExit None - East = NoExit None - West = NoExit None }} - - { Id = RoomId "west1" - Details = - { Name = "A cozy room" - Description = "This room seems very cozy, as if someone had made a home here. Various personal belongings are strewn about."} - Items = [ key ] - Exits = - { North = NoExit None - South = NoExit None - East = PassableExit ("You see a doorway back to the lit room.", RoomId "center") - West = NoExit None }} - - { Id = RoomId "east1" - Details = - { Name = "An open meadow" - Description = "You are in an open meadow. The sun is bright and it takes some time for your eyes to adjust."} - Items = [] - Exits = - { North = NoExit None - South = NoExit None - East = NoExit None - West = PassableExit ("You see stone doorway to the west. Why would you want to go back there?", RoomId "center") }} -] + Description = "This key looks like it could open a nearby door." } } + +let allRooms = + [ { Id = RoomId "center" + Details = + { Name = "A central room" + Description = + "You are standing in a central room with exits in all directions. A single brazier lights the room." } + Items = [] + Exits = + { North = + PassableExit + ("You see a darkened passageway to the north.", + RoomId "north1") + South = + PassableExit + ("You see door to the south. A waft of cold air hits your face.", + RoomId "south1") + East = + LockedExit + ("You see a locked door to the east.", key, + PassableExit + ("You see an open door to the east.", RoomId "east1")) + West = + PassableExit + ("You see an interesting room to the west.", + RoomId "west1") } } + { Id = RoomId "north1" + Details = + { Name = "A dark room" + Description = + "You are standing in a very dark room. You hear the faint sound of rats scurrying along the floor." } + Items = [] + Exits = + { North = NoExit None + South = + PassableExit + ("You see an dimly lit room to the south.", + RoomId "center") + East = NoExit None + West = NoExit None } } + { Id = RoomId "south1" + Details = + { Name = "A cold room" + Description = + "You are standing in a room that feels very cold. Your breath instantly turns into a white puff." } + Items = [] + Exits = + { North = + PassableExit + ("You see an exit to the north. That room looks much warmer.", + RoomId "center") + South = NoExit None + East = NoExit None + West = NoExit None } } + { Id = RoomId "west1" + Details = + { Name = "A cozy room" + Description = + "This room seems very cozy, as if someone had made a home here. Various personal belongings are strewn about." } + Items = [ key ] + Exits = + { North = NoExit None + South = NoExit None + East = + PassableExit + ("You see a doorway back to the lit room.", + RoomId "center") + West = NoExit None } } + + { Id = RoomId "east1" + Details = + { Name = "An open meadow" + Description = + "You are in an open meadow. The sun is bright and it takes some time for your eyes to adjust." } + Items = [] + Exits = + { North = NoExit None + South = NoExit None + East = NoExit None + West = + PassableExit + ("You see stone doorway to the west. Why would you want to go back there?", + RoomId "center") } } ] let player = - { Details = { Name = "Luke"; Description = "Just your average adventurer."} + { Details = + { Name = "Luke" + Description = "Just your average adventurer." } Inventory = [] Location = RoomId "center" } let gameWorld = { Rooms = - allRooms - |> Seq.map (fun room -> (room.Id, room)) - |> Map.ofSeq - Player = player} + allRooms + |> Seq.map (fun room -> (room.Id, room)) + |> Map.ofSeq + Player = player } // -// --------- Logic --------- +// --------- Logic --------- // - type Result<'TSuccess, 'TFailure> = | Success of 'TSuccess | Failure of 'TFailure @@ -128,11 +151,8 @@ let bind processFunc lastResult = | Success s -> processFunc s | Failure f -> Failure f -let (>>=) x f = - bind f x - -let switch processFunc input = - Success (processFunc input) +let (>>=) x f = bind f x +let switch processFunc input = Success(processFunc input) let getRoom world roomId = match world.Rooms.TryFind roomId with @@ -142,8 +162,7 @@ let getRoom world roomId = let describeDetails details = sprintf "\n\n%s\n\n%s\n\n" details.Name details.Description -let extractDetailsFromRoom (room: Room) = - room.Details +let extractDetailsFromRoom (room : Room) = room.Details let describeCurrentRoom world = world.Player.Location @@ -154,25 +173,20 @@ let north exits = exits.North let south exits = exits.South let east exits = exits.East let west exits = exits.West - -let getCurrentRoom world = - world.Player.Location - |> getRoom world - +let getCurrentRoom world = world.Player.Location |> getRoom world let setCurrentRoom world room = - { world with - Player = { world.Player with Location = room.Id} } + { world with Player = { world.Player with Location = room.Id } } let getExit direction exits = match (direction exits) with - | PassableExit (_, roomId) -> Success roomId - | LockedExit (_) -> Failure "There is a locked door in that direction." - | NoExit (_) -> Failure "There is no room in that direction." + | PassableExit(_, roomId) -> Success roomId + | LockedExit(_) -> Failure "There is a locked door in that direction." + | NoExit(_) -> Failure "There is no room in that direction." let move direction world = world |> getCurrentRoom - >>= switch (fun room -> room.Exits) + >>= switch (fun room -> room.Exits) >>= getExit direction >>= getRoom world >>= switch (setCurrentRoom world) @@ -196,35 +210,30 @@ let applyUpdate updateFunc worldState = printfn "\n\n%s\n" message worldState -type GameEngine(initialState: World) = +type GameEngine(initialState : World) = + let gameLoop = MailboxProcessor.Start(fun inbox -> let rec innerLoop worldState = async { let! eventMsg = inbox.Receive() match eventMsg with - | UpdateState updateFunc -> return! innerLoop (applyUpdate updateFunc worldState) + | UpdateState updateFunc -> + return! innerLoop (applyUpdate updateFunc worldState) | ResetState newState -> return! innerLoop newState | EndGameLoop -> return () } - innerLoop initialState) - member this.ApplyUpdate(updateFunc) = - gameLoop.Post(UpdateState updateFunc) - - member this.ResetState(newState) = - gameLoop.Post(ResetState newState) - - member this.Stop() = - gameLoop.Post(EndGameLoop) + member this.ApplyUpdate(updateFunc) = gameLoop.Post(UpdateState updateFunc) + member this.ResetState(newState) = gameLoop.Post(ResetState newState) + member this.Stop() = gameLoop.Post(EndGameLoop) let gameEngine = GameEngine(gameWorld) // -// --------- Command Parsing --------- +// --------- Command Parsing --------- // - type Parser<'a> = Parser of (char list -> Result<'a * char list, string>) let runParser parser inputChars = @@ -234,29 +243,24 @@ let runParser parser inputChars = let expectChar expectedChar = let innerParser inputChars = match inputChars with - | c :: remainingChars -> - if c = expectedChar then Success (c, remainingChars) - else Failure (sprintf "Expected '%c', got '%c'" expectedChar c) + | c :: remainingChars -> + if c = expectedChar then Success(c, remainingChars) + else Failure(sprintf "Expected '%c', got '%c'" expectedChar c) | [] -> - Failure (sprintf "Expected '%c', reached end of input" expectedChar) - + Failure(sprintf "Expected '%c', reached end of input" expectedChar) Parser innerParser -let stringToCharList str = - List.ofSeq str +let stringToCharList str = List.ofSeq str let orParse parser1 parser2 = let innerParser inputChars = match runParser parser1 inputChars with | Success result -> Success result | Failure _ -> runParser parser2 inputChars - Parser innerParser -let ( <|> ) = orParse - -let choice parserList = - List.reduce orParse parserList +let (<|>) = orParse +let choice parserList = List.reduce orParse parserList let anyCharOf validChars = validChars @@ -267,35 +271,27 @@ let andParse parser1 parser2 = let innerParser inputChars = match runParser parser1 inputChars with | Failure msg -> Failure msg - | Success (c1, remaining1) -> + | Success(c1, remaining1) -> match runParser parser2 remaining1 with | Failure msg -> Failure msg - | Success (c2, remaining2) -> - Success ((c1, c2), remaining2) - + | Success(c2, remaining2) -> Success((c1, c2), remaining2) Parser innerParser -let ( .>>. ) = andParse +let (.>>.) = andParse let mapParser mapFunc parser = let innerParser inputChars = match runParser parser inputChars with | Failure msg -> Failure msg - | Success (result, remaining) -> - Success (mapFunc result, remaining) - + | Success(result, remaining) -> Success(mapFunc result, remaining) Parser innerParser let applyParser funcAsParser paramAsParser = - (funcAsParser .>>. paramAsParser) - |> mapParser (fun (f, x) -> f x) - -let ( <*> ) = applyParser + (funcAsParser .>>. paramAsParser) |> mapParser (fun (f, x) -> f x) +let (<*>) = applyParser let returnAsParser result = - let innerParser inputChars = - Success (result, inputChars) - + let innerParser inputChars = Success(result, inputChars) Parser innerParser let liftToParser2 funcToLift paramAsParser1 paramAsParser2 = @@ -304,14 +300,12 @@ let liftToParser2 funcToLift paramAsParser1 paramAsParser2 = let rec sequenceParsers parserList = let cons head rest = head :: rest let consAsParser = liftToParser2 cons - match parserList with | [] -> returnAsParser [] | parser :: remainingParsers -> consAsParser parser (sequenceParsers remainingParsers) -let charListAsString chars = - System.String(List.toArray chars) +let charListAsString chars = System.String(List.toArray chars) let expectString expectedString = expectedString