Skip to content

Instantly share code, notes, and snippets.

@StachuDotNet StachuDotNet/sobokan.fs
Last active Nov 6, 2015

Embed
What would you like to do?
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
@StachuDotNet

This comment has been minimized.

Copy link
Owner Author

StachuDotNet commented Nov 6, 2015

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 :)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.