Last active
November 6, 2015 16:12
-
-
Save StachuDotNet/a072e9bdf9b8ad82aa42 to your computer and use it in GitHub Desktop.
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
open System | |
let exampleLevel = [ | |
" #####" | |
" # #" | |
" #$ #" | |
" ### $##" | |
" # $ $ #" | |
"### # ## # ######" | |
"# # ## ##### ..#" | |
"# $ $ ..#" | |
"##### ### #@## ..#" | |
" # #########" | |
" #######" | |
] | |
type Position = int * int | |
type CellState = Wall | Player | PlayerGoal | Box | BoxGoal | Goal | Floor | |
type CellStateDescriptor = | |
{ CellState: CellState; Character: char; Foreground: ConsoleColor; Background: ConsoleColor } | |
let cellStateDescriptors = [ | |
{ CellState = Wall; Character = '#'; Foreground = ConsoleColor.DarkBlue; Background = ConsoleColor.Blue } | |
{ CellState = Player; Character = '@'; Foreground = ConsoleColor.Green; Background = ConsoleColor.DarkGreen } | |
{ CellState = PlayerGoal; Character = '+'; Foreground = ConsoleColor.Red; Background = ConsoleColor.DarkGreen } | |
{ CellState = Box; Character = '$'; Foreground = ConsoleColor.Yellow; Background = ConsoleColor.DarkYellow } | |
{ CellState = BoxGoal; Character = '*'; Foreground = ConsoleColor.Red; Background = ConsoleColor.DarkYellow } | |
{ CellState = Goal; Character = '.'; Foreground = ConsoleColor.Red; Background = ConsoleColor.Black } | |
{ CellState = Floor; Character = ' '; Foreground = ConsoleColor.Black; Background = ConsoleColor.Black } | |
] | |
let cellStateToCharacter cellState= | |
let descriptor = | |
cellStateDescriptors | |
|> List.tryFind(fun elem -> elem.CellState = cellState) | |
match descriptor with | |
| Some x -> x.Character | |
| None -> '#' // assume wall if unnown | |
let characterToCellState character= | |
let descriptor = | |
cellStateDescriptors | |
|> List.tryFind(fun elem -> elem.Character = character) | |
match descriptor with | |
| None -> Wall // assume wall if unknown | |
| Some x -> x.CellState | |
type Cell = { CellState:CellState; Position:Position } | |
let rec loadRow (rowData: CellState list) (row:int) (column:int) = | |
match rowData with | |
| [] -> [] | |
| head :: tail -> | |
{ CellState=head; Position=(column, row) } :: loadRow (tail) (row) (column+1) | |
let processRow (rowData: string) (row:int) = | |
let processedRow = | |
rowData | |
|> Seq.map(fun elem -> characterToCellState elem) | |
|> Seq.toList | |
loadRow processedRow row 0 | |
let rec loadLevelRow (level: string list) (row:int) = | |
match level with | |
| [] -> [] | |
| head :: tail -> | |
let processedHead = processRow head row | |
let processedTail = loadLevelRow tail (row+1) | |
processedHead @ processedTail | |
let loadLevel (level: string list) = loadLevelRow level 0 | |
let displayLevel (board: Cell list) = | |
let displayCell cell = | |
let descriptor = | |
cellStateDescriptors | |
|> List.find(fun desc -> desc.CellState = cell.CellState) | |
Console.SetCursorPosition cell.Position | |
Console.ForegroundColor <- descriptor.Foreground | |
Console.BackgroundColor <- descriptor.Background | |
printf "%c" descriptor.Character | |
board |> List.iter displayCell | |
let isSolved (board: Cell list) = | |
board | |
|> List.tryFind(fun elem -> elem.CellState = Box) | |
|> Option.isNone | |
type Direction = Up | Down | Left | Right | |
type DirectionDescriptor = { Direction: Direction; Delta: Position; Key: ConsoleKey } | |
let directionDescriptors = [ | |
{ Direction = Up; Delta = ( 0,-1); Key = ConsoleKey.UpArrow } | |
{ Direction = Down; Delta = ( 0, 1); Key = ConsoleKey.DownArrow } | |
{ Direction = Left; Delta = (-1, 0); Key = ConsoleKey.LeftArrow } | |
{ Direction = Right; Delta = ( 1, 0); Key = ConsoleKey.RightArrow } | |
] | |
let getDirectionDescriptorByKey key = directionDescriptors |> List.tryFind(fun elem -> elem.Key=key) | |
let addPositions first second = (fst first + fst second, snd first + snd second) | |
let makeMove (board: Cell list) (delta: Position) = | |
let playerCell = | |
board | |
|> List.find(fun elem -> elem.CellState = Player || elem.CellState = PlayerGoal) | |
let nextPlayerCellState = | |
match playerCell.CellState with | |
| Player -> Floor | |
| _ -> Goal | |
let nextPosition = addPositions playerCell.Position delta | |
let nextCell = | |
board | |
|> List.find(fun elem -> elem.Position = nextPosition) | |
match nextCell.CellState with | |
| x when x=Floor || x=Goal -> | |
let currentPlayerCellState = | |
match x with | |
| Floor -> Player | |
| _ -> PlayerGoal | |
let previousPlayerCell = {CellState = nextPlayerCellState; Position=playerCell.Position} | |
let currentPlayerCell = {CellState = currentPlayerCellState; Position=nextPosition} | |
currentPlayerCell :: (previousPlayerCell :: (board|>List.filter(fun elem-> elem.Position<>playerCell.Position && elem.Position<>nextPosition))) | |
| x when x=Box || x = BoxGoal -> | |
let currentPlayerCellState = | |
match x with | |
| Box -> Player | |
| _ -> PlayerGoal | |
let previousPlayerCell = { CellState = nextPlayerCellState; Position = playerCell.Position } | |
let currentPlayerCell = { CellState = currentPlayerCellState; Position = nextPosition } | |
let nextBoxPosition = addPositions nextPosition delta | |
let nextBoxCell = board |> List.find(fun elem -> elem.Position=nextBoxPosition) | |
match nextBoxCell.CellState with | |
| Floor -> | |
let currentBoxCell = {CellState = Box; Position = nextBoxPosition} | |
currentBoxCell :: (currentPlayerCell :: (previousPlayerCell :: (board|>List.filter(fun elem-> elem.Position<>playerCell.Position && elem.Position<>nextPosition && elem.Position<>nextBoxPosition)))) | |
| Goal -> | |
let currentBoxCell = {CellState = BoxGoal; Position = nextBoxPosition} | |
currentBoxCell :: (currentPlayerCell :: (previousPlayerCell :: (board|>List.filter(fun elem-> elem.Position<>playerCell.Position && elem.Position<>nextPosition && elem.Position<>nextBoxPosition)))) | |
| _ -> board | |
| _ -> board | |
let rec playGame (board: Cell list) = | |
displayLevel board | |
if not <| isSolved board then | |
let key = Console.ReadKey(true).Key | |
let descriptor = getDirectionDescriptorByKey key | |
match descriptor with | |
| None -> board |> playGame | |
| Some x -> makeMove board x.Delta |> playGame | |
[<EntryPoint>] | |
let main argv = | |
Console.BackgroundColor <- ConsoleColor.Black | |
Console.Clear() | |
Console.CursorVisible <- false | |
loadLevel exampleLevel |> playGame | |
Console.ReadLine() |> ignore | |
0 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Lots of these changes are pedantic spacing differences. Please do not take my style as 100% idiomatic F# style; it's just a combination of a few styles I've seen and played with :)