summaryrefslogtreecommitdiff
path: root/client/elm/battlemap
diff options
context:
space:
mode:
Diffstat (limited to 'client/elm/battlemap')
-rw-r--r--client/elm/battlemap/src/Battlemap.elm11
-rw-r--r--client/elm/battlemap/src/Battlemap/Html.elm15
-rw-r--r--client/elm/battlemap/src/Battlemap/Location.elm6
-rw-r--r--client/elm/battlemap/src/Battlemap/Navigator.elm33
-rw-r--r--client/elm/battlemap/src/Battlemap/Tile.elm4
-rw-r--r--client/elm/battlemap/src/Model.elm16
-rw-r--r--client/elm/battlemap/src/Update.elm28
-rw-r--r--client/elm/battlemap/src/View.elm21
8 files changed, 103 insertions, 31 deletions
diff --git a/client/elm/battlemap/src/Battlemap.elm b/client/elm/battlemap/src/Battlemap.elm
index dbf797a..09b4099 100644
--- a/client/elm/battlemap/src/Battlemap.elm
+++ b/client/elm/battlemap/src/Battlemap.elm
@@ -1,4 +1,4 @@
-module Battlemap exposing (Battlemap, random, apply_to_tile)
+module Battlemap exposing (Battlemap, random, apply_to_tile, has_location)
import Array exposing (Array, set, get)
@@ -25,6 +25,15 @@ location_to_index : Battlemap -> Location -> Int
location_to_index bmap loc =
((loc.y * bmap.width) + loc.x)
+has_location : Battlemap -> Location -> Bool
+has_location bmap loc =
+ (
+ (loc.x >= 0)
+ && (loc.y >= 0)
+ && (loc.x < bmap.width)
+ && (loc.y < bmap.height)
+ )
+
apply_to_tile : Battlemap -> Location -> (Tile -> Tile) -> (Maybe Battlemap)
apply_to_tile bmap loc fun =
let
diff --git a/client/elm/battlemap/src/Battlemap/Html.elm b/client/elm/battlemap/src/Battlemap/Html.elm
index d14e075..9f519d1 100644
--- a/client/elm/battlemap/src/Battlemap/Html.elm
+++ b/client/elm/battlemap/src/Battlemap/Html.elm
@@ -9,12 +9,23 @@ import Model exposing (Model)
import Battlemap exposing (Battlemap, random)
import Battlemap.Tile exposing (Tile)
+import Battlemap.Direction exposing (..)
view_battlemap_cell : Tile -> (Html Msg)
view_battlemap_cell t =
(td
[]
- [ (text (toString t.floor_level)) ]
+ [
+ (text
+ (case t.nav_level of
+ Right -> "R"
+ Left -> "L"
+ Up -> "U"
+ Down -> "D"
+ None -> (toString t.floor_level)
+ )
+ )
+ ]
)
type alias GridBuilder =
@@ -81,4 +92,4 @@ view_battlemap battlemap =
view : Model -> (Html Msg)
view m =
- (view_battlemap random)
+ (view_battlemap m.battlemap)
diff --git a/client/elm/battlemap/src/Battlemap/Location.elm b/client/elm/battlemap/src/Battlemap/Location.elm
index ffe3f0d..2fa6d5d 100644
--- a/client/elm/battlemap/src/Battlemap/Location.elm
+++ b/client/elm/battlemap/src/Battlemap/Location.elm
@@ -8,6 +8,8 @@ type alias Location =
y : Int
}
+type alias LocationComparable = (Int, Int)
+
neighbor : Location -> Direction -> Location
neighbor loc dir =
case dir of
@@ -16,3 +18,7 @@ neighbor loc dir =
Up -> {loc | y = (loc.y - 1)}
Down -> {loc | y = (loc.y + 1)}
None -> loc
+
+to_comparable : Location -> (Int, Int)
+to_comparable l =
+ (l.x, l.y)
diff --git a/client/elm/battlemap/src/Battlemap/Navigator.elm b/client/elm/battlemap/src/Battlemap/Navigator.elm
index ffd52cc..b040676 100644
--- a/client/elm/battlemap/src/Battlemap/Navigator.elm
+++ b/client/elm/battlemap/src/Battlemap/Navigator.elm
@@ -1,16 +1,16 @@
module Battlemap.Navigator exposing (Navigator, new_navigator, go)
-import Set exposing (Set, member, empty)
+import Set exposing (Set, member, empty, insert)
-import Battlemap exposing (Battlemap, has_location)
+import Battlemap exposing (Battlemap, has_location, apply_to_tile)
import Battlemap.Location exposing (..)
import Battlemap.Direction exposing (..)
-import Battlemap.Tile exposing (set_tile_direction)
+import Battlemap.Tile exposing (set_direction)
type alias Navigator =
{
current_location : Location,
- visited_locations : (Set Location)
+ visited_locations : (Set LocationComparable)
}
new_navigator : Location -> Navigator
@@ -20,7 +20,7 @@ new_navigator start =
visited_locations = empty
}
-go : Navigator -> Direction -> (Battlemap, Navigator)
+go : Battlemap -> Navigator -> Direction -> (Battlemap, Navigator)
go battlemap nav dir =
let
next_location = (neighbor nav.current_location dir)
@@ -28,23 +28,32 @@ go battlemap nav dir =
if
(
(has_location battlemap next_location)
- && (current_location != next_location)
- && (not (member next_location nav.visited_locations))
+ && (nav.current_location /= next_location)
+ && (not (member (to_comparable next_location) nav.visited_locations))
)
then
(
- (set_tile_direction
- nav.current_location
- dir
+ (case
+ (apply_to_tile
+ battlemap
+ nav.current_location
+ (set_direction dir)
+ )
+ of
+ Nothing -> battlemap
+ (Just bmap) -> bmap
),
{
current_location = next_location,
visited_locations =
(insert
- nav.current_location
+ (to_comparable nav.current_location)
nav.visited_locations
)
}
)
else
- nav
+ (
+ battlemap,
+ nav
+ )
diff --git a/client/elm/battlemap/src/Battlemap/Tile.elm b/client/elm/battlemap/src/Battlemap/Tile.elm
index e8f2493..acedfa4 100644
--- a/client/elm/battlemap/src/Battlemap/Tile.elm
+++ b/client/elm/battlemap/src/Battlemap/Tile.elm
@@ -13,8 +13,8 @@ type alias Tile =
-- mod_level : Int
}
-set_direction : Tile -> Direction -> Tile
-set_direction t d =
+set_direction : Direction -> Tile -> Tile
+set_direction d t =
{t | nav_level = d}
from_int : Int -> Tile
diff --git a/client/elm/battlemap/src/Model.elm b/client/elm/battlemap/src/Model.elm
index 024fc4d..3d69c7d 100644
--- a/client/elm/battlemap/src/Model.elm
+++ b/client/elm/battlemap/src/Model.elm
@@ -1,7 +1,19 @@
module Model exposing (Model, model)
+import Battlemap as Bp exposing (Battlemap, random)
+import Battlemap.Location exposing (..)
+import Battlemap.Navigator as Nr exposing (Navigator, new_navigator)
+
-- MODEL
-type alias Model = Int
+type alias Model =
+ {
+ battlemap: Bp.Battlemap,
+ navigator: (Maybe Nr.Navigator)
+ }
model : Model
-model = 0
+model =
+ {
+ battlemap = (Bp.random),
+ navigator = (Just (Nr.new_navigator {x=2, y=4}))
+ }
diff --git a/client/elm/battlemap/src/Update.elm b/client/elm/battlemap/src/Update.elm
index d03239a..86b9c6e 100644
--- a/client/elm/battlemap/src/Update.elm
+++ b/client/elm/battlemap/src/Update.elm
@@ -1,11 +1,31 @@
-module Update exposing (Msg(Increment, Decrement), update)
+module Update exposing (..)
import Model exposing (Model, model)
-type Msg = Increment | Decrement
+import Battlemap.Direction exposing (..)
+
+import Battlemap.Navigator as Nr exposing (go)
+
+type Msg = DirectionRequest Direction | None
update : Msg -> Model -> Model
update msg model =
case msg of
- Increment -> (model + 1)
- Decrement -> (model - 1)
+ (DirectionRequest d) ->
+ (case model.navigator of
+ Nothing -> model
+ (Just nav) ->
+ let
+ (new_bmap, new_nav) =
+ (Nr.go
+ model.battlemap
+ nav
+ d
+ )
+ in
+ {model |
+ battlemap = new_bmap,
+ navigator = (Just new_nav)
+ }
+ )
+ _ -> model
diff --git a/client/elm/battlemap/src/View.elm b/client/elm/battlemap/src/View.elm
index f4774c7..7058681 100644
--- a/client/elm/battlemap/src/View.elm
+++ b/client/elm/battlemap/src/View.elm
@@ -3,10 +3,11 @@ module View exposing (view)
import Html exposing (Html, button, div, text, table, tr, td)
import Html.Events exposing (onClick)
-import Update exposing (Msg(Increment, Decrement))
+import Update exposing (..)
import Model exposing (Model)
import Battlemap.Html as Batmap exposing (view)
+import Battlemap.Direction exposing (..)
-- VIEW
@@ -16,16 +17,20 @@ view model =
[]
[
(button
- [ (onClick Decrement) ]
- [ (text "-") ]
+ [ (onClick (DirectionRequest Left)) ]
+ [ (text "Left") ]
),
- (div
- []
- [ (text (toString model)) ]
+ (button
+ [ (onClick (DirectionRequest Down)) ]
+ [ (text "Down") ]
+ ),
+ (button
+ [ (onClick (DirectionRequest Up)) ]
+ [ (text "Up") ]
),
(button
- [ (onClick Increment) ]
- [ (text "+") ]
+ [ (onClick (DirectionRequest Right)) ]
+ [ (text "Right") ]
),
(div
[]