Floating label for a cartesian chart

Label.elm

type alias Label =
    { content : String
    , mainColor : String
    , textColor : String

    -- origin point, in data coordinates
    , dataX : Float
    , dataY : Float

    -- origin point Y, in svg coordinates
    , svgY : Float

    -- label Y, in svg coordinates
    , labelSvgY : Float
    , isLeftOfPoint : Bool
    }




pointToPolygonString ( x, y ) =
    toString x ++ "," ++ toString y


pointToPathString ( x, y ) =
    toString x ++ " " ++ toString y


labelStyle label =
    [ Css.height (Css.pct 100)
    , Css.display Css.inlineBlock
    , Css.backgroundColor (Css.hex label.mainColor)
    , Css.padding2 Css.zero (Css.rem 0.25)
    , Css.color (Css.hex label.textColor)
    , Css.border3 (Css.px 1) Css.solid (Css.hex label.textColor)
    , if label.isLeftOfPoint then
        Css.borderRight Css.zero
      else
        Css.borderLeft Css.zero
    ]



pointLabel : Label -> Svg msg
pointLabel label =
    let
        labelYOffsetInSvgCoordinates =
            label.labelSvgY - label.svgY

        sign =
            if label.isLeftOfPoint then
                -1
            else
                1

        labelXOffsetInSvgCoordinates =
            labelToPointDistanceInSvgCoordinates * sign

        -- there are the two points where the triangle touches the label proper
        upperSeamPoint =
            ( labelXOffsetInSvgCoordinates, labelYOffsetInSvgCoordinates - labelHeightInSvgCoordinates / 4 )

        lowerSeamPoint =
            ( labelXOffsetInSvgCoordinates, labelYOffsetInSvgCoordinates + labelHeightInSvgCoordinates / 4 )

        triangle =
            [ ( 0, 0 )
            , upperSeamPoint
            , lowerSeamPoint
            ]
                |> List.map pointToPolygonString
                |> String.join " "

        seamBorder =
            [ "M" ++ pointToPathString ( labelXOffsetInSvgCoordinates, labelYOffsetInSvgCoordinates - labelHeightInSvgCoordinates / 2 )
            , "L" ++ pointToPathString upperSeamPoint
            , "L" ++ pointToPathString ( 0, 0 )
            , "L" ++ pointToPathString lowerSeamPoint
            , "L" ++ pointToPathString ( labelXOffsetInSvgCoordinates, labelYOffsetInSvgCoordinates + labelHeightInSvgCoordinates / 2 )
            ]
                |> String.join " "

        foreignW =
          200

        foreignX =
            labelXOffsetInSvgCoordinates

    in
        Svg.g
            []
            [ Svg.foreignObject
                [ SA.x <| toString foreignX
                , SA.y <| toString <| labelYOffsetInSvgCoordinates - labelHeightInSvgCoordinates / 2
                , SA.height <| toString labelHeightInSvgCoordinates
                , SA.width <| toString foreignW
                ]
                [ Html.div
                    []
                    [ Html.div
                        []
                        [ Html.span
                            [ HA.style <| Css.asPairs <| labelStyle label ]
                            [ Html.text label.content ]
                        ]
                    ]
                ]
            , Svg.polygon
                [ SA.points triangle
                , SA.fill label.mainColor

                -- This is necessary to make the seam invisible
                , SA.stroke label.mainColor
                ]
                []
            , Svg.path
                [ SA.d seamBorder
                , SA.fill "none"
                , SA.stroke label.textColor
                , SA.strokeWidth "1"
                ]
                []
            ]