Curves

module Curves exposing (main)


import Color exposing (Color)
import Example
import Path exposing (Path)
import Scale exposing (ContinuousScale)
import Scale.Color
import Shape
import SubPath exposing (SubPath)
import TypedSvg exposing (g, line, rect, svg, text_)
import TypedSvg.Attributes as Explicit exposing (fill, fontFamily, stroke, transform, viewBox)
import TypedSvg.Attributes.InPx exposing (height, strokeWidth, width, x, x1, x2, y, y1, y2)
import TypedSvg.Core exposing (Svg, text)
import TypedSvg.Types exposing (Paint(..), Transform(..), percent)


w : Float
w =
    990


h : Float
h =
    450


padding : Float
padding =
    50


points : List ( Float, Float )
points =
    [ ( 0.1, 0.1 )
    , ( 0.2, 0.6 )
    , ( 0.35, 0.3 )
    , ( 0.45, 0.3 )
    , ( 0.6, 0.2 )
    , ( 0.9, 0.8 )
    , ( 1.2, 0.6 )
    , ( 1.5, 0.9 )
    , ( 1.7, 0.2 )
    , ( 1.9, 0.1 )
    ]


xScale : ContinuousScale Float
xScale =
    Scale.linear ( padding, w - padding ) ( 0, 2 )


yScale : ContinuousScale Float
yScale =
    Scale.linear ( h - padding, padding ) ( 0, 1 )


preparedPoints : List ( Float, Float )
preparedPoints =
    List.map (\( x, y ) -> ( Scale.convert xScale x, Scale.convert yScale y )) points


xGridLine : Int -> Float -> Svg msg
xGridLine index tick =
    line
        [ y1 0
        , Explicit.y2 (percent 100)
        , x1 (Scale.convert xScale tick)
        , x2 (Scale.convert xScale tick)
        , stroke <| Paint Color.white
        , strokeWidth (Basics.max (toFloat (modBy 2 index)) 0.5)
        ]
        []


yGridLine : Int -> Float -> Svg msg
yGridLine index tick =
    line
        [ x1 0
        , Explicit.x2 (percent 100)
        , y1 (Scale.convert yScale tick)
        , y2 (Scale.convert yScale tick)
        , stroke <| Paint Color.white
        , strokeWidth (Basics.max (toFloat (modBy 2 index)) 0.5)
        ]
        []


type alias Curve =
    List ( Float, Float ) -> SubPath


drawCurve : ( String, Path, Color ) -> Svg msg
drawCurve ( _, path, color ) =
    Path.element path [ stroke (Paint color), fill PaintNone, strokeWidth 2 ]


drawLegend : Int -> ( String, Path, Color ) -> Svg msg
drawLegend index ( name, _, color ) =
    text_ [ fill (Paint color), fontFamily [ "monospace" ], x padding, y (toFloat index * 20 + padding) ] [ text name ]


view : List ( String, Path, Color ) -> Svg msg
view model =
    svg [ viewBox 0 0 w h ]
        [ rect [ width w, height h, fill <| Paint <| Color.rgb255 223 223 223 ] []
        , g [] <| List.indexedMap yGridLine <| Scale.ticks yScale 10
        , g [] <| List.indexedMap xGridLine <| Scale.ticks xScale 20
        , g [] <|
            List.map drawCurve model
        , g [] <| List.map (\( dx, dy ) -> Path.element circle [ fill (Paint Color.white), stroke (Paint Color.black), transform [ Translate dx dy ] ]) preparedPoints
        , g [] <| List.indexedMap drawLegend <| model
        ]


circle : Path
circle =
    Shape.arc
        { innerRadius = 0
        , outerRadius = 3
        , cornerRadius = 0
        , startAngle = 0
        , endAngle = 2 * pi
        , padAngle = 0
        , padRadius = 0
        }


basic : String -> Curve -> List ( String, Path, Color )
basic prefix curveFn =
    [ ( prefix, [ curveFn preparedPoints ], Color.black ) ]


parametrized : String -> (Float -> Curve) -> List ( String, Path, Color )
parametrized prefix curveFn =
    let
        scale =
            Scale.sequential Scale.Color.magmaInterpolator ( 0, 1 )

        stops =
            [ 0, 0.25, 0.5, 0.75, 1 ]
    in
    stops
        |> List.map (\s -> ( prefix ++ " " ++ String.fromFloat s, [ curveFn s preparedPoints ], Scale.convert scale s ))


main : Example.Program (List ( String, Path, Color ))
main =
    [ ( "Linear", basic "linearCurve" Shape.linearCurve )
    , ( "Basis", basic "basisCurve" Shape.basisCurve )
    , ( "BasisClosed", basic "basisCurveClosed" Shape.basisCurveClosed )
    , ( "BasisOpen", basic "basisCurveOpen" Shape.basisCurveOpen )
    , ( "Bundle", parametrized "bundleCurve" Shape.bundleCurve )
    , ( "Cardinal", parametrized "cardinalCurve" Shape.cardinalCurve )
    , ( "CardinalClosed", parametrized "cardinalCurveClosed" Shape.cardinalCurveClosed )
    , ( "CardinalOpen", parametrized "cardinalCurveOpen" Shape.cardinalCurveOpen )
    , ( "CatmullRom", parametrized "catmullRomCurve" Shape.catmullRomCurve )
    , ( "CatmullRomClosed", parametrized "catmullRomCurveClosed" Shape.catmullRomCurveClosed )
    , ( "CatmullRomOpen", parametrized "catmullRomCurveOpen" Shape.catmullRomCurveOpen )
    , ( "MonotoneInX", basic "monotoneInXCurve" Shape.monotoneInXCurve )
    , ( "Step", parametrized "stepCurve" Shape.stepCurve )
    , ( "Natural", basic "naturalCurve" Shape.naturalCurve )
    , ( "BumpX", basic "bumpXCurve" Shape.bumpXCurve )
    , ( "BumpY", basic "bumpYCurve" Shape.bumpYCurve )
    ]
        |> Example.tabbed "Curve type:"
        |> Example.application view