Adds UI to test the Navigator.

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
             []