Make tiles editable

src/FunkyFunktions.elm

@@ -4,13 +4,12 @@ import Array exposing (get, set)
 
 constant a b = a
 flip f a b = f b a
-compose f1 f2 a = f1 (f2 a)
 withCmd cmd model = (model, cmd)
 withoutCmd model = (model, Cmd.none)
 andCmd cmd2 (model, cmd1) = (model, Cmd.batch [cmd1, cmd2])
 curry2 f (a, b) = f a b
 uncurry2 f a b = f (a, b)
-updateArray f i a =
+updateArray i f a =
   case get i a of
     Just e -> set i (f e) a
     Nothing -> a

src/Main.elm

@@ -8,9 +8,9 @@ import Browser
 import Browser.Dom exposing (getViewport, Viewport)
 import Browser.Navigation exposing (Key)
 import Browser.Events exposing (onResize)
-import Html exposing (div, h3, Html, section, text)
-import Html.Attributes exposing (class, style)
-import Html.Events exposing (onClick)
+import Html exposing (div, h3, input, Html, section, text)
+import Html.Attributes exposing (class, style, value)
+import Html.Events exposing (onClick, onInput)
 import Json.Decode as D
 import List exposing (map, singleton)
 import String exposing (fromInt)
@@ -33,6 +33,7 @@ type Msg
   = Noop
   | Click Int Int Int Int
   | WindowSize Int Int
+  | SetTileText Int Int String
 
 type alias Model =
   { windowW: Int
@@ -115,7 +116,11 @@ viewTile columnIndex tileIndex tile =
           (D.field "layerY" D.int)
       )
     ]
-    [ text tile.text
+    [ input
+      [ value tile.text
+      , onInput (SetTileText columnIndex tileIndex)
+      ]
+      []
     , svg
       [ Svg.Attributes.class "tile-stickers"
       , height "80"
@@ -125,31 +130,51 @@ viewTile columnIndex tileIndex tile =
       (map viewSticker tile.stickers)
     ]
 
+-- viewAddTile : Int -> Html Msg
+-- viewAddTile columnIndex =
+--   div
+--     [ class "add-tile"
+--     , onClick
+
 addStickerToTile : Sticker -> Tile -> Tile
 addStickerToTile sticker tile =
   { tile | stickers = sticker :: tile.stickers }
 
-addStickerToColumn : Int -> Sticker -> Column -> Column
-addStickerToColumn tileIndex sticker column =
+updateTileText : String -> Tile -> Tile
+updateTileText text tile =
+  { tile | text = text }
+
+modTileInColumn : Int -> (Tile -> Tile) -> Column -> Column
+modTileInColumn tileIndex f column =
   { column | tiles =
     updateArray
-      (addStickerToTile sticker)
       tileIndex
+      f
       column.tiles
   }
 
+modColumnInPage : Int -> (Column -> Column) -> Model -> Model
+modColumnInPage columnIndex f model =
+  { model | columns =
+    updateArray
+      columnIndex
+      f
+      model.columns
+  }
+
 update : Msg -> Model -> (Model, Cmd Msg)
 update msg model = case Debug.log "UPDATE" (msg, model) of
   (Noop, _) -> (model, Cmd.none)
   (WindowSize w h, _) ->
     { model | windowW = w, windowH = h }
       |> withoutCmd
-  (Click columnIndex tileIndex x y, {columns}) ->
-    { model
-    | columns =
-      updateArray
-        (addStickerToColumn tileIndex (Sticker (TextSticker "red" "<3") "Into This" x y))
-        columnIndex
-        columns
-    }
+  (Click columnIndex tileIndex x y, _) ->
+    (modColumnInPage columnIndex << modTileInColumn tileIndex)
+      (addStickerToTile <| Sticker (TextSticker "red" "<3") "Into This" x y)
+      model
+      |> withoutCmd
+  ( SetTileText columnIndex tileIndex newText, _) ->
+    (modColumnInPage columnIndex << modTileInColumn tileIndex)
+      (updateTileText newText)
+      model
       |> withoutCmd

style.sass

@@ -15,14 +15,22 @@ body
 		.tile
 			background-color: #fcedd6 //e2b97a
 			position: relative
-			width: 360px
-			height: 80px
-			padding: 0 20px
 
 			display: grid
 			align-items: center
 
+			input
+				padding: 20px
+				margin: 0
+				height: 40px
+				background: none
+				border: none
+
+				&:focus-visible
+					border: none
+
 			.tile-stickers
 				position: absolute
 				top: 0
-				left: 0
+				left: 0
+				pointer-events: none // Allow clicking the input box below this