Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
A sokoban player in F# (.NET, console-based)
open System
let exampleLevel = [
" #####";
" # #";
" #$ #";
" ### $##";
" # $ $ #";
"### # ## # ######";
"# # ## ##### ..#";
"# $ $ ..#";
"##### ### #@## ..#";
" # #########";
" #######"
]
type Position = { x: int; y: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={x=column;y=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) =
board
|> List.iter(fun elem ->
let descriptor =
cellStateDescriptors
|> List.find(fun desc -> desc.CellState=elem.CellState)
Console.SetCursorPosition(elem.Position.x,elem.Position.y)
Console.ForegroundColor <- descriptor.Foreground
Console.BackgroundColor <- descriptor.Background
printf "%c" descriptor.Character
)
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 = { x = 0; y = -1}; Key = ConsoleKey.UpArrow }
{ Direction = Down; Delta = { x = 0; y =1}; Key = ConsoleKey.DownArrow }
{ Direction = Left; Delta = { x = -1; y =0}; Key = ConsoleKey.LeftArrow }
{ Direction = Right; Delta = { x = 1; y =0}; Key = ConsoleKey.RightArrow }
]
let getDirectionDescriptorByKey key =
directionDescriptors|>List.tryFind(fun elem->elem.Key=key)
let addPositions first second = { x = (first.x + second.x); y = (first.y + second.y) }
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 isSolved board then
board
else
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
let board = loadLevel exampleLevel
playGame board |> ignore
Console.ReadLine() |> ignore
0
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.