sobokan.fs

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

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