yes-no-maybe-kink-tool/src/Main.elm

module Main exposing (main)

import FunkyFunktions exposing (..)
import Presets exposing (activities)
import Stickers exposing (Sticker, StickerContent(..), viewSticker)

import Array exposing (Array, get, set)
import Array.Extra as Array
import Browser
import Browser.Dom exposing (focus, getViewport, Viewport)
import Browser.Navigation exposing (Key)
import Browser.Events exposing (onMouseMove, onMouseUp, onResize)
import Html exposing (Attribute, button, div, h3, input, Html, section, text)
import Html.Attributes exposing (class, disabled, id, style, value)
import Html.Attributes.Extra as Attributes exposing (attributeIf)
import Html.Extra exposing (viewMaybe)
import Html.Events exposing (onBlur, onClick, onInput, onMouseDown, onMouseEnter, onMouseLeave)
import Html.Events.Extra exposing (onEnter)
import Html.Lazy exposing (lazy, lazy2)
import Json.Decode as D
import List exposing (map, singleton)
import Maybe.Extra exposing (isJust)
import String exposing (fromInt, isEmpty)
import String.Extra exposing (isBlank)
import Svg exposing (path, Svg, svg)
import Svg.Attributes exposing (d, fill, height, stroke, viewBox, width)
import Svg.Events exposing (on)
import Task
import Url exposing (Url)

main = Browser.application
  { init = init
  , view = view
  , update = update
  , onUrlChange = constant Noop
  , onUrlRequest = constant Noop
  , subscriptions = subscriptions
  }

type Msg
  = Noop
  | Click Int Int Int Int
  | SetTileText Int Int String
  | AddTile Int
  | PruneTile Int Int
  | HeldOverNewTile Int Int
  | NewMousePos Int Int
  | StartDrag Int Int Tile Int Int
  | StopDrag

type alias Model =
  { columns: Array Column
  , heldTile: Maybe HeldTile
  , mousePos: (Int, Int)
  }

type alias Column =
  { name: String
  , tiles: Array Tile
  }

type alias Tile =
  { text: String
  , stickers: List Sticker
  }

type alias HeldTile =
  { hoveredColumnIndex: Int
  , hoveredTileIndex: Int
  , tile: Tile
  }

blankTile = { text = "", stickers = [] }

init : () -> Url -> Key -> (Model, Cmd Msg)
init flags url browserKey =
  { columns =
    [ { name = "Into"
      , tiles = Array.empty
      }
    , { name = "Willing"
      , tiles = Array.empty
      }
    , { name = "Maybe"
      , tiles = Array.empty
      }
    , { name = "No"
      , tiles = Array.empty
      }
    ]
    |> Array.fromList
  , mousePos = (200, 200)
  , heldTile = Nothing
  }
    |> withoutCmd

subscriptions : Model -> Sub Msg
subscriptions model =
  if (isJust model.heldTile)
    then
      Sub.batch
        [ onMouseMove <|
          D.map2 NewMousePos
            (D.field "pageX" D.int)
            (D.field "pageY" D.int)
        , onMouseUp <| D.succeed StopDrag
        ]
    else Sub.none


view : Model -> Browser.Document Msg
view {columns, heldTile, mousePos} =
  [ lazy2 viewColumns heldTile columns
  , lazy viewWordbank activities
  , viewMaybe (viewFloatyTile mousePos) heldTile
  ]
    |> Browser.Document "meow!"

viewColumns : Maybe HeldTile -> Array Column -> Html Msg
viewColumns heldTile columns =
  Array.indexedMap (viewColumn heldTile) columns
    |> Array.map (singleton >> div [])
    |> Array.toList
    |> section
      [ class "columns"
      ]


viewFloatyTile : (Int, Int) -> HeldTile -> Html Msg
viewFloatyTile (mouseX, mouseY) { tile, hoveredColumnIndex } =
  div
    [ style "top"  (mouseY |> String.fromInt |> flip (++) "px")
    , style "left" (mouseX |> String.fromInt |> flip (++) "px")
    , id "floaty-tile"
    , class ((++) "hovering-" <| String.fromInt <| 1 + hoveredColumnIndex)
    ]
    [ viewTile False -1 -1 tile ]


viewHoverTile = div [id "hover-tile"] []

viewColumn : Maybe HeldTile -> Int -> Column -> Html Msg
viewColumn heldOverTile columnIndex {name, tiles} =
  let
      isTileHeld = isJust heldOverTile
      tileCount = Array.length tiles
      onlyTrueActivityTiles = Array.indexedMap (viewTile isTileHeld columnIndex) tiles
      trueActivityTilesPlusHoverTile = case heldOverTile of
        Nothing -> onlyTrueActivityTiles
        Just {hoveredColumnIndex, hoveredTileIndex} ->
          if hoveredColumnIndex == columnIndex
            then
              Array.insertAt
                hoveredTileIndex
                viewHoverTile
                onlyTrueActivityTiles
            else onlyTrueActivityTiles
      tilesList = Array.toList trueActivityTilesPlusHoverTile
  in
    div
      [ class "column"
      , attributeIf isTileHeld (onMouseLeave <| HeldOverNewTile -1 -1)
      ]
      ( ( h3
           []
           [text name]
        ) :: tilesList
          ++ [ viewAddTile isTileHeld columnIndex tileCount ]
      )

viewTile : Bool -> Int -> Int -> Tile -> Html Msg
viewTile isTileHeld columnIndex tileIndex tile =
  div
    [ class "tile"
    -- , on "click" <| (
    --     D.map2 (Click columnIndex tileIndex)
    --       (D.field "layerX" D.int)
    --       (D.field "layerY" D.int)
    --   )
    , attributeIf isTileHeld (onMouseEnter <| HeldOverNewTile columnIndex tileIndex)
    ]
    [ viewGrip 24 columnIndex tileIndex tile
    , input
      [ value tile.text
      , onInput (SetTileText columnIndex tileIndex)
      , attributeIf (isBlank tile.text) <| onBlur (PruneTile columnIndex tileIndex)
      , attributeIf (isBlank tile.text) (id "new-tile")
      , onEnter (AddTile columnIndex)
      ]
      []
    , svg
      [ Svg.Attributes.class "tile-stickers"
      , height "64"
      , width "320"
      , style "user-select" "none"
      ]
      (map viewSticker tile.stickers)
    ]

viewGrip : Int -> Int -> Int -> Tile -> Html Msg
viewGrip size colIndx tileIndx tile =
  svg
    [ viewBox "0 0 103.4 103.4"
    , width <| String.fromInt size
    , height <| String.fromInt size
    , Svg.Attributes.class "drag-gripper"
    , on "mousedown" <| (
        D.map2 (StartDrag colIndx tileIndx tile)
          (D.field "pageX" D.int)
          (D.field "pageY" D.int)
      )
    ]
    [ path
      [ d gripPath
      , fill "currentColor"
      , stroke "none"
      ]
      []
    ]

gripPath = "m17.697 3.3505e-8a17.698 17.698 0 0 0-17.697 17.697 17.698 17.698 0 0 0 17.697 17.699 17.698 17.698 0 0 0 17.699-17.699 17.698 17.698 0 0 0-17.699-17.697zm68 0a17.698 17.698 0 0 0-17.697 17.697 17.698 17.698 0 0 0 17.697 17.699 17.698 17.698 0 0 0 17.699-17.699 17.698 17.698 0 0 0-17.699-17.697zm-68 68a17.698 17.698 0 0 0-17.697 17.697 17.698 17.698 0 0 0 17.697 17.699 17.698 17.698 0 0 0 17.699-17.699 17.698 17.698 0 0 0-17.699-17.697zm68 0a17.698 17.698 0 0 0-17.697 17.697 17.698 17.698 0 0 0 17.697 17.699 17.698 17.698 0 0 0 17.699-17.699 17.698 17.698 0 0 0-17.699-17.697z"

viewAddTile : Bool -> Int -> Int -> Html Msg
viewAddTile isTileHeld columnIndex tileCount =
  button
    [ class "add-tile"
    , class "tile"
    , onClick (AddTile columnIndex)
    , attributeIf isTileHeld (onMouseEnter <| HeldOverNewTile columnIndex tileCount)
    ]
    [ text "+" ]

viewWordbank : List String -> Html Msg
viewWordbank wordlist =
  section
    [ id "word-bank"
    ]
    (map viewMiniTile wordlist)

viewMiniTile : String -> Html Msg
viewMiniTile word =
  div
    [ class "tile"
    , class "mini-tile"
    ]
    [ viewGrip 16 -1 -1 { text = word, stickers = [] }
    , input
      [ value word
      , disabled True
      ]
      []
    ]

addStickerToTile : Sticker -> Tile -> Tile
addStickerToTile sticker tile =
  { tile | stickers = sticker :: tile.stickers }

addTileToColumn : Column -> Column
addTileToColumn column =
  { column | tiles = Array.push blankTile column.tiles }

isTileEmpty : Tile -> Bool
isTileEmpty = .text >> isEmpty

updateTileText : String -> Tile -> Tile
updateTileText text tile =
  { tile | text = text }

removeTileFromColumn : Int -> Column -> Column
removeTileFromColumn tileIndex column =
  { column | tiles =
    Array.removeAt
      tileIndex
      column.tiles
  }

insertTileToColumn : Int -> Tile -> Column -> Column
insertTileToColumn tileIndex tile column =
  { column | tiles =
    Array.insertAt
      tileIndex
      tile
      column.tiles
  }

modTileInColumn : Int -> (Tile -> Tile) -> Column -> Column
modTileInColumn tileIndex f column =
  { column | tiles =
    Array.update
      tileIndex
      f
      column.tiles
  }

modColumnInPage : Int -> (Column -> Column) -> Model -> Model
modColumnInPage columnIndex f model =
  { model | columns =
    Array.update
      columnIndex
      f
      model.columns
  }

update : Msg -> Model -> (Model, Cmd Msg)
update msg model = case Debug.log "UPDATE" msg of
  Noop -> (model, Cmd.none)
  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
  AddTile columnIndex ->
    modColumnInPage columnIndex
      addTileToColumn
      model
      |> withCmd (Task.attempt (constant Noop) (focus "new-tile"))
  PruneTile columnIndex tileIndex ->
    modColumnInPage columnIndex
      (removeTileFromColumn tileIndex)
      model
      |> withoutCmd
  HeldOverNewTile columnIndex tileIndex -> case model.heldTile of
    Nothing -> model |> withoutCmd
    Just oldHeldTileInfo ->
      let
        newTileIndex =
          if oldHeldTileInfo.hoveredColumnIndex /= columnIndex
            then tileIndex
          else if oldHeldTileInfo.hoveredTileIndex == tileIndex
            then tileIndex + 1
            else tileIndex
      in
        { model
        | heldTile =
          Just
            { oldHeldTileInfo
            | hoveredColumnIndex = columnIndex
            , hoveredTileIndex = newTileIndex
            }
        }
          |> withoutCmd
  NewMousePos x y ->
    { model | mousePos = (x, y) }
    |> withoutCmd
  StartDrag colIndx tileIndx tile mouseX mouseY ->
    let
      modelWithTileRemoved =
        modColumnInPage colIndx
        (removeTileFromColumn tileIndx)
        model
    in
      { modelWithTileRemoved
      | heldTile = Just
        { hoveredColumnIndex = colIndx
        , hoveredTileIndex = tileIndx
        , tile = tile
        }
      , mousePos = (mouseX, mouseY)
      }
        |> withoutCmd
  StopDrag ->
    case model.heldTile of
      Nothing -> model |> withoutCmd
      Just {hoveredColumnIndex, hoveredTileIndex, tile} ->
        let
          modelWithTileInserted =
            modColumnInPage hoveredColumnIndex
            (insertTileToColumn hoveredTileIndex tile)
            model
        in
          { modelWithTileInserted | heldTile = Nothing }
          |> withoutCmd