Rogue.elm

import Dict exposing (Dict)

import Graphics.Collage as Collage exposing (Form)
import Graphics.Element as Element exposing (Element)

import Keyboard
import Signal
import Time
import String
import Text
import Color

import Random exposing (..)

type alias Located a = Dict (Int, Int) a

type alias GameState =
    { terrain : List (Located Tile)
    , level   : Int
    , loot    : Located Loot
    , player  : (Int, Int)
    }

type Loot = No

type Tile
    = Open
    | Wall
    | Door Int
    | Portal Dir
    | Lever Int

type Dir = Forth | Back

type Action = Go { x : Int, y : Int }

type alias Room = { origin : (Int, Int), dims : (Int, Int) }

room : Generator Room
room =
    Random.map2 (\a b -> {origin = a, dims = b})
        (pair base base)
        (pair offset offset)

base   = int -6 6
offset = int 2 5

addRoom room =
    let
        (x0, y0) = room.origin
        (dx, dy) = room.dims
        (x1, y1) = (x0 + dx - 1, y0 + dy - 1)
    in Dict.union
    <| Dict.fromList
    <|  forRange x0 x1 <| \x ->
        forRange y0 y1 <| \y ->
            one ((x, y), Open)

make : Action -> GameState -> GameState
make action gs = case action of
    Go {x, y} ->
        let
            currentLevel = Maybe.withDefault Dict.empty (list_get gs.level gs.terrain)
            (x0, y0) = gs.player
            newPoint = (x + x0, y + y0)
        in
            case Dict.get newPoint currentLevel of
                Just Open ->
                    { gs | player = newPoint }

                Just (Door id) -> if id < 0
                    then { gs | player = newPoint }
                    else   gs

                Just (Lever id) ->
                    { gs
                    | player  = newPoint
                    , terrain =
                        gs.terrain |> List.map (Dict.map <| \_ -> toggleDoor id)
                    }

                Just (Portal Forth) ->
                    { gs
                    | player = (0, 0)
                    , level = (gs.level + 1) % List.length gs.terrain
                    }

                Just (Portal Back) ->
                    { gs
                    | player = (0, 0)
                    , level = (gs.level + 1) % List.length gs.terrain
                    }

                _ ->
                    gs

at pos list mod = case (pos, list) of
    (0, x :: xs) -> mod x :: xs
    (_, x :: xs) -> x :: at (pos - 1) xs mod
    _            -> list

list_get pos list = case (pos, list) of
    (0, x :: xs) -> Just x
    (_, x :: xs) -> list_get (pos - 1) xs
    _            -> Nothing

toggleDoor key tile = case tile of
    Door id ->
        if key == id || key == -id
        then Door (-id)
        else tile
    _ ->
        tile

--pregen
--    =  Signal.map Seed
--    <| Signal.map initialSeed
--    <| Signal.map round
--    <| Signal.map Time.inMilliseconds
--    <| Signal.map (Maybe.withDefault Time.second)
--    <| Signal.dropRepeats
--    <| Signal.foldp (\x y -> Maybe.oneOf [y, x]) Nothing
--    <| Signal.map Just
--    <| Time.every Time.millisecond

input
    = -- Signal.merge pregen <|
    Signal.map Go
    <| Signal.filter isMovement {x = 0, y = 0}
    <| Signal.merge Keyboard.arrows Keyboard.wasd

isMovement {x, y} = x /= 0 || y /= 0

draw : (Int, Int) -> GameState -> Element
draw (w, h) gs =
    let
        currentLevel = Maybe.withDefault Dict.empty (list_get gs.level gs.terrain)
        visible = getObserved (w, h) gs.player currentLevel
    in
        visible
        |> Dict.map (\_ terrain ->
            case terrain of
                Open    -> a_open
                Wall    -> a_wall
                Door id -> if id > 0 then a_door1 else a_door2
                Lever _ -> a_key
                Portal Forth -> a_exit
                Portal Back  -> a_back
        )
        |> Dict.insert (0, 0) a_player
        |> drawSpriteMap 16 (w * 16) (h * 16)

getObserved : (Int, Int) -> (Int, Int) -> Located Tile -> Located Tile
getObserved (w, h) (x0, y0) landscape =
    Dict.fromList <|
        forRange (x0 - w // 2) (x0 + w // 2) <| \x ->
        forRange (y0 - h // 2) (y0 + h // 2) <| \y ->
            let
                locus = (x - x0, y - y0)
            in
                one (locus, Maybe.withDefault Wall (Dict.get (x, y) landscape))

forRange from to callback = List.concatMap callback [from .. to]
one x = [x]

sprite (x, y) = Collage.toForm
    <| Element.image 16 16
    <| "sprites/" ++ toString y ++ "-" ++ toString x ++ ".jpeg"

wall   = sprite(4, 0)
open   = sprite(1, 1)
door2  = sprite(12, 2)
door1  = sprite(13, 3)
key    = sprite(0, 6)
exit   = sprite(0, 0)
player = sprite(3, 6)

glyph char col = char
    |> String.fromChar
    |> Text.fromString
    |> Text.monospace
    |> Text.height 16
    |> Text.color col
    |> Element.leftAligned
    |> Collage.toForm

a_wall   = glyph '#' Color.darkBrown
a_open   = glyph '.' Color.gray
a_door1  = glyph 'D' Color.green
a_door2  = glyph '.' Color.green
a_key    = glyph '/' Color.green
a_exit   = glyph '@' Color.purple
a_back   = glyph '@' Color.orange
a_player = glyph '@' Color.black

drawSpriteMap : Int -> Int -> Int -> Located Form -> Element
drawSpriteMap edge w h =
    let scale c = toFloat (c * edge)
    in Dict.map (\(x, y) -> Collage.move (scale x, scale y))
    >> Dict.values
    >> Collage.collage w h

addDoor num (x, y) = Dict.insert (x, y) (Door  num)
addKey  num (x, y) = Dict.insert (x, y) (Lever num)
addExit     (x, y) = Dict.insert (x, y) (Portal Forth)
addBack     (x, y) = Dict.insert (x, y) (Portal Back)

initialState =
    { terrain =
        [ Dict.empty
            |> addRoom { origin = (-1, -1), dims = (4, 3) }
            |> addRoom { origin = (-7, -2), dims = (5, 5) }
            |> addDoor 1 (-2, 0)
            |> addKey  1 (2, 0)
            |> addExit   (-5, 0)
            |> addKey  2 (-7, 2)

        , Dict.empty
            |> addRoom { origin = (-1, -1), dims = (3, 3) }
            |> addRoom { origin = (-5, -0), dims = (5, 1) }
            |> addRoom { origin = (-5, -0), dims = (1, 5) }
            |> addRoom { origin = (-5,  5), dims = (5, 1) }
            |> addRoom { origin = (0,  5), dims = (3, 3) }
            |> addDoor 2 (-1, 5)
            |> addExit   (1, 6)
            |> addBack   (0, 0)
        ]
    , level   = 0
    , loot    = Dict.empty
    , player  = (0, 0)
    }

game = Signal.foldp make initialState input

main = Signal.map (draw (21, 11)) game
-- main = Signal.map Element.show game