Main.elm

module Main exposing (..)

import Browser
import Dict exposing (Dict)
import Json.Decode as Decode exposing (Decoder)
import Svg exposing (..)
import Svg.Attributes exposing (..)
import Svg.Events exposing (..)


type Msg
    = Create Coords
    | StartMove Int Coords
    | StopMove
    | Move Coords


main =
    Browser.sandbox { init = { nodes = Dict.empty, nextId = 0, moving = Nothing }, update = update, view = view }


type alias Coords =
    { x : Float, y : Float }


coordsDecoder : (Coords -> Msg) -> Decoder Msg
coordsDecoder msg =
    Decode.map msg <| Decode.map2 Coords (Decode.field "pageX" Decode.float) (Decode.field "pageY" Decode.float)


type MoveParams
    = MoveParams Int Coords


type alias Model =
    { nodes : Dict Int Coords, nextId : Int, moving : Maybe MoveParams }


update : Msg -> Model -> Model
update msg model =
    case msg of
        Create coords ->
            { nodes = Dict.insert model.nextId coords model.nodes, nextId = model.nextId + 1, moving = model.moving }

        StartMove id coords ->
            { model | moving = Maybe.map (\centre -> MoveParams id { x = centre.x - coords.x, y = centre.y - coords.y }) (Dict.get id model.nodes) }

        StopMove ->
            { model | moving = Nothing }

        Move coords ->
            case model.moving of
                Nothing ->
                    model

                Just (MoveParams id offset) ->
                    { model | nodes = Dict.insert id { x = coords.x + offset.x, y = coords.y + offset.y } model.nodes }


makeNode ( id, coord ) =
    circle [ cx <| String.fromFloat coord.x, cy <| String.fromFloat coord.y, r "25", stopPropagationOn "mousedown" <| Decode.map (\a -> ( a, True )) (coordsDecoder (StartMove id)) ] []


-- We include a background rectangle to capture the create events instead of doing this at the top level to avoid clicks on the nodes themselves propagating
view : Model -> Svg Msg
view model =
    svg
        [ width "1024"
        , height "768"
        , viewBox "0 0 1024 768"
        , on "mouseup" (Decode.succeed StopMove)
        , on "mousemove" (coordsDecoder Move)
        ]
        (rect [ x "0", y "0", width "1024", height "768", fill "white", on "click" (coordsDecoder Create) ] [] :: List.map makeNode (Dict.toList model.nodes))