Adding the Prettifier...

3 files changed, 243 insertions, 0 deletions

diff --git a/src/map-editor/src/Struct/Model.elm b/src/map-editor/src/Struct/Model.elm
index 5e6eef7..ffa413f 100644
--- a/src/map-editor/src/Struct/Model.elm
+++ b/src/map-editor/src/Struct/Model.elm
@@ -3,6 +3,7 @@ module Struct.Model exposing
       Type,
       new,
       add_tile,
+      add_tile_pattern,
       invalidate,
       reset,
       clear_error
@@ -19,6 +20,7 @@ import Struct.Flags
 import Struct.HelpRequest
 import Struct.Map
 import Struct.Tile
+import Struct.TilePattern
 import Struct.Toolbox
 import Struct.UI
 
@@ -32,6 +34,7 @@ type alias Type =
       toolbox: Struct.Toolbox.Type,
       help_request: Struct.HelpRequest.Type,
       map: Struct.Map.Type,
+      tile_patterns: (Dict.Dict (Maybe Int) (List Struct.TilePattern.Type)),
       tiles: (Dict.Dict Struct.Tile.Ref Struct.Tile.Type),
       error: (Maybe Struct.Error.Type),
       player_id: String,
@@ -57,6 +60,7 @@ new flags =
             help_request = Struct.HelpRequest.None,
             map = (Struct.Map.empty),
             tiles = (Dict.empty),
+            tile_patterns = [],
             error = Nothing,
             map_id = "",
             player_id =
@@ -92,6 +96,49 @@ add_tile tl model =
          )
    }
 
+add_tile_pattern : Struct.TilePattern.Type -> Type -> Type
+add_tile_pattern tp model =
+   case (Struct.TilePattern.get_source_pattern tp) of
+      (Struct.TilePattern.Exactly i) ->
+         case (Dict.get (Just i) model.tile_patterns) of
+            Nothing ->
+               {model |
+                  tile_patterns =
+                     (Dict.insert (Just i) [tp] model.tile_patterns)
+               }
+
+            (Just l) ->
+               {model |
+                  tile_patterns =
+                     (Dict.insert (Just i) (tp :: l) model.tile_patterns)
+               }
+
+      _ ->
+         case (Dict.get Nothing model.tile_patterns) of
+            Nothing ->
+               {model |
+                  tile_patterns =
+                     (Dict.insert Nothing [tp] model.tile_patterns)
+               }
+
+            (Just l) ->
+               {model |
+                  tile_patterns =
+                     (Dict.insert Nothing (tp :: l) model.tile_patterns)
+               }
+
+get_tile_patterns_for : Int -> Type -> (List Struct.TilePattern.Type)
+get_tile_patterns_for i model =
+   case (Dict.get (Just i) model.tile_patterns) of
+      Nothing -> []
+      (Just r) -> r
+
+get_wild_tile_patterns : Type -> (List Struct.TilePattern.Type)
+get_wild_tile_patterns model =
+   case (Dict.get Nothing model.tile_patterns) of
+      Nothing -> []
+      (Just r) -> r
+
 reset : Type -> Type
 reset model =
    {model |
diff --git a/src/map-editor/src/Struct/TilePattern.elm b/src/map-editor/src/Struct/TilePattern.elm
new file mode 100644
index 0000000..3a4c752
--- /dev/null
+++ b/src/map-editor/src/Struct/TilePattern.elm
@@ -0,0 +1,111 @@
+module Struct.TilePattern exposing
+   (
+      PatternElement(..),
+      Type,
+      decoder,
+      matches,
+      matches_pattern,
+      get_source_pattern,
+      get_target
+   )
+
+-- Elm -------------------------------------------------------------------------
+import List
+
+import Json.Decode
+import Json.Decode.Pipeline
+
+-- Battlemap -------------------------------------------------------------------
+import Constants.UI
+import Constants.Movement
+
+import Struct.Location
+
+import Util.List
+
+--------------------------------------------------------------------------------
+-- TYPES -----------------------------------------------------------------------
+--------------------------------------------------------------------------------
+type PatternElement =
+   Any
+   | Exactly Int
+   | Not Int
+
+type alias Type =
+   {
+      s : PatternElement,
+      t : Int,
+      p : (List PatternElement)
+   }
+
+type alias PartialPatternElement =
+   {
+      c : String,
+      i : Int
+   }
+
+--------------------------------------------------------------------------------
+-- LOCAL -----------------------------------------------------------------------
+--------------------------------------------------------------------------------
+
+matches_internals : (List Int) -> (List PatternElement) -> Bool
+matches_internals neighbors pattern =
+   case ((Util.List.pop neighbors), (Util.List.pop pattern)) of
+      (Nothing, Nothing) -> True
+      ((Just (n, r_n)), (Just (p, r_p))) ->
+         ((matches_pattern n p) && (matches_internals r_n r_p))
+
+      (_, _) -> False
+
+finish_decoding_pattern : PartialPatternElement -> PatternElement
+finish_decoding_pattern ppe =
+   case ppe.c of
+      "a" -> Any
+      "n" -> (Not ppe.i)
+      _ -> (Exactly ppe.i)
+
+pattern_decoder : (Json.Decode.Decoder PatternElement)
+pattern_decoder =
+   (Json.Decode.map
+      (finish_decoding_pattern)
+      (Json.Decode.Pipeline.decode
+         PartialPatternElement
+         |> (Json.Decode.Pipeline.required "c" Json.Decode.string)
+         |> (Json.Decode.Pipeline.required "i" Json.Decode.int)
+      )
+   )
+
+--------------------------------------------------------------------------------
+-- EXPORTED --------------------------------------------------------------------
+--------------------------------------------------------------------------------
+matches_pattern : Int -> PatternElement -> Bool
+matches_pattern n p =
+   case p of
+      (Exactly v) -> (v == n)
+      (Not v) -> (v /= n)
+      Any -> True
+
+matches : (List Int) -> Int -> Type -> Bool
+matches neighbors source tile_pattern =
+   (
+      (matches_pattern source tile_pattern.s)
+      && (matches_internals neighbors tile_pattern.p)
+   )
+
+decoder : (Json.Decode.Decoder Type)
+decoder =
+   (Json.Decode.Pipeline.decode
+      Type
+      |> (Json.Decode.Pipeline.required "s" (pattern_decoder))
+      |> (Json.Decode.Pipeline.required "t" Json.Decode.int)
+      |> (Json.Decode.Pipeline.required
+            "p"
+            (Json.Decode.list (pattern_decoder))
+         )
+   )
+
+get_target : Type -> Int
+get_target tile_pattern = tile_pattern.t
+
+get_source_pattern : Type -> Int
+get_source_pattern tile_pattern = tile_pattern.t
diff --git a/src/map-editor/src/Update/PrettifySelectedTiles.elm b/src/map-editor/src/Update/PrettifySelectedTiles.elm
new file mode 100644
index 0000000..f6a23ce
--- /dev/null
+++ b/src/map-editor/src/Update/PrettifySelectedTiles.elm
@@ -0,0 +1,85 @@
+module Update.PrettifySelectedTiles exposing (apply_to)
+-- Elm -------------------------------------------------------------------------
+
+-- Battlemap -------------------------------------------------------------------
+import Struct.Event
+import Struct.Toolbox
+import Struct.Map
+import Struct.Tile
+import Struct.TilePattern
+import Struct.Model
+
+--------------------------------------------------------------------------------
+-- LOCAL -----------------------------------------------------------------------
+--------------------------------------------------------------------------------
+apply_to_location : (
+      (List Struct.TilePattern.Type) ->
+      Struct.Model.Type ->
+      Struct.Location.Type ->
+      Struct.Map.Type ->
+      Struct.Map.Type ->
+   )
+apply_to_location wild_patterns model loc map =
+   case (Struct.Map.try_getting_tile_at loc map) of
+      Nothing -> map
+      (Just base) ->
+         let
+            base_id = (Struct.Tile.get_type_id base)
+            full_neighborhood_class_ids =
+               (List.map
+                  (\e ->
+                     case (Struct.Map.try_getting_tile_at \e map) of
+                        Nothing -> -1
+                        (Just e) -> (Struct.Tile.get_type_id e)
+                  )
+                  (Struct.Map.try_getting_tile_at loc map)
+               )
+         in
+            case
+               (Util.List.get_first
+                  (Struct.TilePattern.matches
+                     full_neighborhood_class_ids
+                     base_id
+                  )
+                  (Struct.Model.get_tile_patterns_for base_id model)
+               )
+            of
+               (Just pattern) -> -- TODO
+
+               Nothing ->
+                  case
+                     (Util.List.get_first
+                        (Struct.TilePattern.matches
+                           full_neighborhood_class_ids
+                           base_id
+                        )
+                        wild_patterns
+                     )
+                  of
+                     (Just pattern) -> -- TODO
+
+                     Nothing -> map
+
+--------------------------------------------------------------------------------
+-- EXPORTED --------------------------------------------------------------------
+--------------------------------------------------------------------------------
+apply_to : (
+      Struct.Model.Type ->
+      (Struct.Model.Type, (Cmd Struct.Event.Type))
+   )
+apply_to model =
+   (
+      {model |
+         map =
+            (List.foldl
+               (apply_to_location
+                  (Struct.Model.get_wild_tile_patterns model)
+                  model
+               )
+               model.map
+               (Struct.Toolbox.get_selection model.toolbox)
+            )
+      }
+      {model | toolbox = (Struct.Toolbox.set_mode mode model.toolbox)},
+      Cmd.none
+   )