Tear everything up, switch to column-based layout

src/FunkyFunktions.elm

@@ -1,4 +1,7 @@
 module FunkyFunktions exposing (..)
+
+import Array exposing (get, set)
+
 constant a b = a
 flip f a b = f b a
 compose f1 f2 a = f1 (f2 a)
@@ -6,4 +9,8 @@ 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)
+uncurry2 f a b = f (a, b)
+updateArray f i a =
+  case get i a of
+    Just e -> set i (f e) a
+    Nothing -> a

src/Main.elm

@@ -3,11 +3,14 @@ module Main exposing (main)
 import FunkyFunktions exposing (..)
 import Stickers exposing (Sticker, StickerContent(..), viewSticker)
 
+import Array exposing (Array, get, set)
 import Browser
 import Browser.Dom exposing (getViewport, Viewport)
 import Browser.Navigation exposing (Key)
 import Browser.Events exposing (onResize)
-import Html.Attributes exposing (style)
+import Html exposing (div, h3, Html, section, text)
+import Html.Attributes exposing (class, style)
+import Html.Events exposing (onClick)
 import Json.Decode as D
 import List exposing (map, singleton)
 import String exposing (fromInt)
@@ -28,58 +31,112 @@ main = Browser.application
 
 type Msg
   = Noop
-  | Click Int Int
+  | Click Int Int Int Int
   | WindowSize Int Int
 
 type alias Model =
   { windowW: Int
   , windowH: Int
-  , stickers: List Sticker
+  , columns: Array Column
   }
 
-sqrt2 = sqrt 2
+type alias Column =
+  { name: String
+  , tiles: Array Tile
+  }
+
+type alias Tile =
+  { text: String
+  , stickers: List Sticker
+  }
 
 viewportToWindowSize : Viewport -> Msg
 viewportToWindowSize { viewport } =
   WindowSize (round viewport.width) (round viewport.height)
 
-canvasSize : Int -> Int -> (Int, Int)
-canvasSize windowW windowH =
-  if (toFloat windowW) / (toFloat windowH) < sqrt2
-    then (windowW, (toFloat windowW) / sqrt2 |> round)
-    else (sqrt2 * (toFloat windowH) |> round, windowH)
-
-translateToCanvasCoords : Int -> Int -> Int -> Int -> (Int, Int)
-translateToCanvasCoords realCanvasW realCanvasH x y =
-  (x * 11890 // realCanvasW, y * 8410 // realCanvasH)
-
 init : () -> Url -> Key -> (Model, Cmd Msg)
 init flags url browserKey =
-  {windowW = 1, windowH = 1, stickers = []}
+  { windowW = 1
+  , windowH = 1
+  , columns =
+    [ { name = "Yes - Into"
+      , tiles =
+        [ Tile
+          "Vore"
+          [(Sticker (TextSticker "red" "<3") "Into This" 100 40)]
+        ] |> Array.fromList
+      }
+    , { name = "Yes - Willing"
+      , tiles = Array.empty
+      }
+    , { name = "Maybe"
+      , tiles = Array.empty
+      }
+    , { name = "No"
+      , tiles = Array.empty
+      }
+    ]
+    |> Array.fromList
+  }
     |> withCmd (
       getViewport
         |> Task.perform viewportToWindowSize
     )
 
 view : Model -> Browser.Document Msg
-view {windowW, windowH, stickers} =
-  let
-    (canvasW, canvasH) = canvasSize windowW windowH
-  in
-    svg
-      [ viewBox "0 0 11890 8410"
-      , width <| fromInt canvasW
-      , height <| fromInt canvasH
+view {windowW, windowH, columns} =
+  section
+    [ class "columns"
+    ]
+    ( Array.indexedMap viewColumn columns
+        |> Array.toList
+    )
+    |> singleton
+    |> Browser.Document "meow!"
+
+viewColumn : Int -> Column -> Html Msg
+viewColumn columnIndex {name, tiles} =
+  div
+    [ class "column"
+    ]
+    ( ( h3
+         []
+         [text name]
+      ) :: (Array.indexedMap (viewTile columnIndex) tiles |> Array.toList)
+    )
+
+viewTile : Int -> Int -> Tile -> Html Msg
+viewTile columnIndex tileIndex tile =
+  div
+    [ class "tile"
+    , on "click" <| (
+        D.map2 (Click columnIndex tileIndex)
+          (D.field "x" D.int)
+          (D.field "y" D.int)
+      )
+    ]
+    [ text tile.text
+    , svg
+      [ Svg.Attributes.class "tile-stickers"
+      , height "80"
+      , width "400"
       , style "user-select" "none"
-      , on "click" <| (
-          D.map2 (uncurry2 <| compose (curry2 Click) (curry2 <| translateToCanvasCoords canvasW canvasH))
-            (D.field "x" D.int)
-            (D.field "y" D.int)
-        )
       ]
-      (map viewSticker stickers)
-      |> singleton
-      |> Browser.Document "meow!"
+      (map viewSticker tile.stickers)
+    ]
+
+addStickerToTile : Sticker -> Tile -> Tile
+addStickerToTile sticker tile =
+  { tile | stickers = sticker :: tile.stickers }
+
+addStickerToColumn : Int -> Sticker -> Column -> Column
+addStickerToColumn tileIndex sticker column =
+  { column | tiles =
+    updateArray
+      (addStickerToTile sticker)
+      tileIndex
+      column.tiles
+  }
 
 update : Msg -> Model -> (Model, Cmd Msg)
 update msg model = case Debug.log "UPDATE" (msg, model) of
@@ -87,6 +144,12 @@ update msg model = case Debug.log "UPDATE" (msg, model) of
   (WindowSize w h, _) ->
     { model | windowW = w, windowH = h }
       |> withoutCmd
-  (Click x y, {stickers}) ->
-    { model | stickers = (Sticker (TextSticker "red" "<3" ) "Into This" x y ) :: stickers }
+  (Click columnIndex tileIndex x y, {columns}) ->
+    { model
+    | columns =
+      updateArray
+        (addStickerToColumn tileIndex (Sticker (TextSticker "red" "<3") "Into This" x y))
+        columnIndex
+        columns
+    }
       |> withoutCmd

src/Stickers.elm

@@ -21,13 +21,13 @@ viewSticker sticker =
   let
     attributes =
       [ x <| fromInt sticker.x
-      , y <| fromInt (sticker.y + 100)
+      , y <| fromInt (sticker.y + 13)
       ]
   in case sticker.content of
     TextSticker color textContent ->
       text_
         (  fill color
-        :: fontSize "200px"
+        :: fontSize "30px"
         :: textAnchor "middle"
         :: attributes
         )