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 Base64.Encode as B64E
import Base64.Decode as B64D
import Browser
import Browser.Dom exposing (focus, getViewport, Viewport)
import Browser.Navigation exposing (Key, pushUrl)
import Browser.Events exposing (onMouseMove, onMouseUp, onResize)
import Cbor exposing (CborItem(..))
import Cbor.Encode as CE
import Cbor.Decode as CD
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 List.Extra exposing (elemIndex, getAt)
import Maybe exposing (andThen)
import Maybe.Extra exposing (isJust)
import Result exposing (toMaybe)
import String exposing (dropLeft, fromInt, isEmpty, replace, toLower)
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)
  , browserKey: Key
  }

type alias Column = { 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 =
  let
    m =
      case load browserKey url of
        Just model -> model
        Nothing ->
          { columns = Array.repeat 4 (Column Array.empty)
          , mousePos = (200, 200)
          , heldTile = Nothing
          , browserKey = browserKey
          }
  in m |> 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 {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 <| columnIndexToName columnIndex]
        ) :: tilesList
          ++ [ viewAddTile isTileHeld columnIndex tileCount ]
      )

columnIndexToName : Int -> String
columnIndexToName i = case i of
  0 -> "Into"
  1 -> "Willing"
  2 -> "Maybe"
  3 -> "No"
  _ -> "Too Many Columns"

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
      |> withSaveCmd
  AddTile columnIndex ->
    modColumnInPage columnIndex
      addTileToColumn
      model
      |> withCmd (Task.attempt (constant Noop) (focus "new-tile"))
  PruneTile columnIndex tileIndex ->
    modColumnInPage columnIndex
      (removeTileFromColumn tileIndex)
      model
      |> withSaveCmd
  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 }
          |> withSaveCmd

withSaveCmd : Model -> (Model, Cmd Msg)
withSaveCmd model = (model, save model)

andSaveCmd : (Model, Cmd Msg) -> (Model, Cmd Msg)
andSaveCmd (model, cmd) = (model, Cmd.batch [cmd, save model])

save : Model -> Cmd Msg
save model =
  saveModel model
  |> CE.encode
  |> B64E.bytes
  |> B64E.encode
  |> dropLeft 1
  |> replace "=" ""
  |> (++) "#"
  |> pushUrl model.browserKey

load : Key -> Url -> Maybe Model
load key url =
  url.fragment
  |> Maybe.map ((++) "g")
  |> andThen (B64D.decode B64D.bytes >> toMaybe)
  |> andThen (CD.decode (loadModel key))


saveModel : Model -> CE.Encoder
saveModel { columns } =
  Array.toList columns
  |> map saveColumn
  |> CE.sequence

array4 a b c d = Array.fromList [a, b, c, d]

loadModel : Key -> CD.Decoder Model
loadModel key =
  CD.map4 array4 loadColumn loadColumn loadColumn loadColumn
  |> CD.map Model
  |> CD.map ((|>) Nothing)
  |> CD.map ((|>) (0, 0))
  |> CD.map ((|>) key)

saveColumn : Column -> CE.Encoder
saveColumn { tiles } = CE.list saveTile (Array.toList tiles)

loadColumn : CD.Decoder Column
loadColumn =
  CD.list loadTile
  |> CD.map Array.fromList
  |> CD.map Column

saveTile : Tile -> CE.Encoder
saveTile { text } =
  case elemIndex (toLower text) activities of
    Just index -> CE.int index
    Nothing -> CE.string text

loadTile : CD.Decoder Tile
loadTile =
  CD.any
  |> CD.andThen loadTileInner

loadTileInner : CborItem -> CD.Decoder Tile
loadTileInner item =
  let
    word =
      case item of
        CborInt i ->
          case getAt i activities of
            Just activity -> CD.succeed activity
            Nothing -> CD.fail
        CborString s -> CD.succeed s
        _ -> CD.fail
  in
    CD.map (flip Tile []) word