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

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.