/src/Template/Cuts.elm at f91e95b40d78c2bb7c293c91b51cc563e6923ff5

-- Copyright 2026 Shota FUJI
--
-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.
--
-- SPDX-License-Identifier: MPL-2.0


module Template.Cuts exposing (cuts)

import Length exposing (Length, toMM)
import Parameters exposing (LoopStyle(..), Parameters, Profile(..), TipStyle(..))
import Parameters.Key exposing (Key(..))
import Svg exposing (..)
import Svg.Attributes exposing (..)
import Svg.Path as Path exposing (..)
import Template.Layout.Container as Container exposing (aligned, columns, gapped, noGrow, padded, rows, sized)
import Template.Layout.Coordinate exposing (Request(..))
import Template.Layout.Item exposing (Item)


highlightStroke : Bool -> Svg.Attribute msg
highlightStroke enabled =
    if enabled then
        class "highlight-stroke"

    else
        class "highlight-none"


cuts : Parameters -> Maybe Key -> Item msg
cuts params highlighting =
    -- TODO: Pack items more smartly, so it won't push infoArea out
    rows
        |> sized (AtLeast 0) (AtLeast 0)
        |> aligned Container.Start
        |> padded (toMM params.rendering.gap / 2)
        |> gapped (toMM params.rendering.gap)
        |> Container.build
            ([ columns
                |> gapped (toMM params.rendering.gap * 2)
                |> Container.build
                    [ surfacePieces params highlighting |> noGrow
                    , paddings params highlighting |> noGrow
                    ]
                |> Just
             , loops params highlighting
             ]
                |> List.filterMap identity
                |> List.map noGrow
            )


surfacePieces : Parameters -> Maybe Key -> Item msg
surfacePieces params highlighting =
    rows
        |> aligned Container.Center
        |> gapped (toMM params.rendering.gap / 2)
        |> Container.build
            [ Item
                { width = Exactly 50, height = Exactly 5 }
                (\p size ->
                    text_
                        [ x (String.fromFloat (p.x + size.width / 2))
                        , y (String.fromFloat p.y)
                        , fontSize "5"
                        , fontWeight "100"
                        , textAnchor "middle"
                        , dominantBaseline "hanging"
                        , fill "currentColor"
                        ]
                        [ text "Main pieces" ]
                )
            , columns
                |> gapped (toMM params.rendering.gap)
                |> Container.build
                    [ longPiece params highlighting, shortPiece params highlighting ]
            ]


guideStroke : List (Svg.Attribute msg)
guideStroke =
    [ fill "none"
    , stroke "currentColor"
    , strokeWidth "0.1"
    , strokeDasharray "0.5 1"
    ]


type alias LongPieceShapeProps =
    { x : Float
    , y : Float
    , offset : Float
    , highlighting : Maybe Key
    , parameters : Parameters
    }


longPieceShape : LongPieceShapeProps -> Svg msg
longPieceShape { x, y, offset, highlighting, parameters } =
    let
        shoulderWidth =
            toMM parameters.shoulderWidth - offset * 2

        length =
            toMM parameters.longPiece.length - offset

        taperUntil =
            Basics.min
                (toMM parameters.longPiece.buckleHole.distance
                    - (toMM parameters.longPiece.buckleHole.interval * toFloat (parameters.longPiece.buckleHole.adjustments + 1))
                )
                (length / 2)

        taper =
            case parameters.profile of
                Straight ->
                    0.0

                Tapered to ->
                    shoulderWidth - (toMM to - offset * 2)

        buckleWidth =
            shoulderWidth - taper

        curvedSectionLength =
            case parameters.longPiece.tip of
                Round ->
                    buckleWidth / 2

                Pointed _ ->
                    buckleWidth
    in
    Svg.g
        []
        [ Svg.path
            [ Path.d
                (MoveTo Absolute ( x, y )
                    :: LineTo Relative ( taper / 2, taperUntil )
                    :: VerticalLineTo Relative (length - curvedSectionLength - taperUntil)
                    :: (case parameters.longPiece.tip of
                            Round ->
                                [ EllipticalArcCurve Relative
                                    { rx = buckleWidth / 2
                                    , ry = buckleWidth / 2
                                    , angle = 0.0
                                    , largeArcFlag = LargeArc
                                    , sweepFlag = Counterclockwise
                                    , x = buckleWidth
                                    , y = 0
                                    }
                                    []
                                ]

                            Pointed sharpness ->
                                let
                                    sy =
                                        buckleWidth * (toFloat (100 - sharpness) / 100)
                                in
                                [ CubicBezierCurve
                                    Relative
                                    ( ( 0, sy )
                                    , ( buckleWidth / 2, buckleWidth )
                                    , ( buckleWidth / 2, buckleWidth )
                                    )
                                    []
                                , CubicBezierCurve
                                    Relative
                                    ( ( 0, 0 )
                                    , ( buckleWidth / 2, -(buckleWidth - sy) )
                                    , ( buckleWidth / 2, -buckleWidth )
                                    )
                                    []
                                ]
                       )
                    ++ [ VerticalLineTo Relative -(length - curvedSectionLength - taperUntil)
                       , LineTo Relative ( taper / 2, -taperUntil )
                       , ClosePath
                       ]
                )
            , fill "none"
            , stroke "currentColor"
            , strokeWidth (toMM parameters.rendering.lineWidth |> String.fromFloat)
            , highlightStroke
                (highlighting
                    == Just LongPieceLength
                    || highlighting
                    == Just ShoulderWidth
                    || highlighting
                    == Just Profile
                    || highlighting
                    == Just TaperTo
                    || (case parameters.profile of
                            Straight ->
                                False

                            Tapered _ ->
                                highlighting
                                    == Just BuckleHoleDistance
                                    || highlighting
                                    == Just BuckleHoleInterval
                       )
                )
            ]
            []
        , Svg.path
            (Path.d
                [ MoveTo Absolute ( x + shoulderWidth / 2, y )
                , VerticalLineTo Relative length
                ]
                :: highlightStroke (highlighting == Just LongPieceLength)
                :: guideStroke
            )
            []
        , case parameters.longPiece.tip of
            Round ->
                g [] []

            Pointed _ ->
                Svg.path
                    (Path.d
                        [ MoveTo Absolute ( x + taper / 2, y + (length - curvedSectionLength) )
                        , HorizontalLineTo Relative buckleWidth
                        ]
                        :: guideStroke
                    )
                    []
        , case parameters.profile of
            Straight ->
                g [] []

            Tapered _ ->
                Svg.path
                    (Path.d
                        [ MoveTo Absolute ( x + taper / 2, y + taperUntil )
                        , HorizontalLineTo Relative buckleWidth
                        ]
                        :: highlightStroke
                            (highlighting
                                == Just ShoulderWidth
                                || highlighting
                                == Just TaperTo
                                || highlighting
                                == Just BuckleHoleDistance
                                || highlighting
                                == Just BuckleHoleAdjustments
                                || highlighting
                                == Just BuckleHoleInterval
                                || highlighting
                                == Just BuckleHoleDiameter
                            )
                        :: guideStroke
                    )
                    []
        ]


longPiece : Parameters -> Maybe Key -> Item msg
longPiece params highlighting =
    let
        shoulderWidth =
            toMM params.shoulderWidth

        length =
            toMM params.longPiece.length
    in
    { size = { width = Exactly shoulderWidth, height = Exactly length }
    , element =
        \p _ ->
            g
                []
                (longPieceShape
                    { x = p.x
                    , y = p.y
                    , offset = 0
                    , highlighting = highlighting
                    , parameters = params
                    }
                    :: (List.range 0 (params.longPiece.buckleHole.adjustments * 2)
                            |> List.map
                                (\index ->
                                    let
                                        { buckleHole } =
                                            params.longPiece

                                        distance =
                                            toMM buckleHole.distance

                                        interval =
                                            toMM buckleHole.interval
                                    in
                                    hole
                                        params
                                        buckleHole.diameter
                                        ( p.x + shoulderWidth / 2
                                        , p.y + distance + interval * toFloat (index - params.longPiece.buckleHole.adjustments)
                                        )
                                        [ highlightStroke
                                            (highlighting
                                                == Just BuckleHoleDiameter
                                                || highlighting
                                                == Just BuckleHoleDistance
                                                || highlighting
                                                == Just BuckleHoleInterval
                                                || highlighting
                                                == Just BuckleHoleAdjustments
                                            )
                                        ]
                                )
                       )
                )
    }


hole : Parameters -> Length -> ( Float, Float ) -> List (Svg.Attribute msg) -> Svg msg
hole params diameter ( cx, cy ) attrs =
    let
        radius =
            toMM diameter / 2
    in
    g
        []
        [ circle
            (Svg.Attributes.cx (String.fromFloat cx)
                :: Svg.Attributes.cy (String.fromFloat cy)
                :: r (String.fromFloat radius)
                :: fill "none"
                :: stroke "currentColor"
                :: strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                :: attrs
            )
            []
        , g
            [ fill "none"
            , stroke "currentColor"
            , strokeWidth "0.1"
            ]
            [ Svg.path
                [ Path.d
                    [ MoveTo Absolute ( cx - radius / 2, cy )
                    , HorizontalLineTo Relative radius
                    ]
                ]
                []
            , Svg.path
                [ Path.d
                    [ MoveTo Absolute ( cx, cy - radius / 2 )
                    , VerticalLineTo Relative radius
                    ]
                ]
                []
            ]
        ]


type alias ShortPieceShapeProps =
    LongPieceShapeProps


shortPieceShape : ShortPieceShapeProps -> Svg msg
shortPieceShape { x, y, offset, parameters, highlighting } =
    let
        shoulderWidth =
            toMM parameters.shoulderWidth - offset * 2

        length =
            toMM parameters.shortPiece.length - offset

        taperUntil =
            Basics.min
                (toMM parameters.longPiece.buckleHole.distance
                    - (toMM parameters.longPiece.buckleHole.interval * toFloat (parameters.longPiece.buckleHole.adjustments + 1))
                )
                (length - 10)

        taper =
            case parameters.profile of
                Straight ->
                    0.0

                Tapered to ->
                    shoulderWidth - (toMM to - offset * 2)
    in
    g
        []
        [ Svg.path
            [ Path.d
                ([ Just (MoveTo Absolute ( x, y ))
                 , Just (LineTo Relative ( taper / 2, taperUntil ))
                 , Just (VerticalLineTo Relative (length - taperUntil))
                 , Just (HorizontalLineTo Relative (shoulderWidth - taper))
                 , Just (VerticalLineTo Relative -(length - taperUntil))
                 , Just (LineTo Relative ( taper / 2, -taperUntil ))
                 , Just ClosePath
                 ]
                    |> List.filterMap identity
                )
            , fill "none"
            , stroke "currentColor"
            , strokeWidth (toMM parameters.rendering.lineWidth |> String.fromFloat)
            , highlightStroke
                (highlighting
                    == Just ShortPieceLength
                    || highlighting
                    == Just ShoulderWidth
                    || highlighting
                    == Just Profile
                    || highlighting
                    == Just TaperTo
                    || (case parameters.profile of
                            Straight ->
                                False

                            Tapered _ ->
                                highlighting
                                    == Just BuckleHoleDistance
                                    || highlighting
                                    == Just BuckleHoleInterval
                       )
                )
            ]
            []
        , Svg.path
            (Path.d
                [ MoveTo Absolute ( x + shoulderWidth / 2, y )
                , VerticalLineTo Relative length
                ]
                :: highlightStroke (highlighting == Just ShortPieceLength)
                :: guideStroke
            )
            []
        , case parameters.profile of
            Straight ->
                g [] []

            Tapered _ ->
                Svg.path
                    (Path.d
                        [ MoveTo Absolute ( x + taper / 2, y + taperUntil )
                        , HorizontalLineTo Relative (shoulderWidth - taper)
                        ]
                        :: guideStroke
                    )
                    []
        ]


shortPiece : Parameters -> Maybe Key -> Item msg
shortPiece params highlighting =
    let
        shoulderWidth =
            toMM params.shoulderWidth

        length =
            toMM params.shortPiece.length
    in
    { size =
        { width = Exactly shoulderWidth, height = Exactly length }
    , element =
        \p _ ->
            shortPieceShape
                { x = p.x
                , y = p.y
                , offset = 0
                , parameters = params
                , highlighting = highlighting
                }
    }


loops : Parameters -> Maybe Key -> Maybe (Item msg)
loops params highlighting =
    let
        root =
            params.shortPiece.loops
    in
    case ( root.fixed, root.free ) of
        ( Nothing, Nothing ) ->
            Nothing

        _ ->
            rows
                |> aligned Container.Center
                |> gapped (toMM params.rendering.gap / 2)
                |> Container.build
                    [ Item
                        { width = Exactly 40, height = Exactly 5 }
                        (\p size ->
                            text_
                                [ x (String.fromFloat (p.x + size.width / 2))
                                , y (String.fromFloat p.y)
                                , fontSize "5"
                                , fontWeight "100"
                                , textAnchor "middle"
                                , dominantBaseline "hanging"
                                , fill "currentColor"
                                ]
                                [ text "Loops" ]
                        )
                    , columns
                        |> gapped (toMM params.rendering.gap)
                        |> aligned Container.Center
                        |> Container.build
                            ([ fixedLoop params highlighting
                             , freeLoop params highlighting
                             ]
                                |> List.filterMap identity
                            )
                    ]
                |> Just


fixedLoop : Parameters -> Maybe Key -> Maybe (Item msg)
fixedLoop params highlighting =
    Maybe.map
        (\{ width, length } ->
            { size =
                { width = Exactly (toMM length)
                , height =
                    Exactly
                        (case params.shortPiece.loops.style of
                            Simple ->
                                toMM width

                            Folded ->
                                toMM width * 2
                        )
                }
            , element =
                \p size ->
                    g
                        []
                        [ Svg.path
                            [ Path.d
                                [ MoveTo Absolute ( p.x, p.y )
                                , HorizontalLineTo Relative size.width
                                , VerticalLineTo Relative size.height
                                , HorizontalLineTo Relative -size.width
                                , ClosePath
                                ]
                            , fill "none"
                            , stroke "currentColor"
                            , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                            , highlightStroke (highlighting == Just FixedLoopWidth || highlighting == Just FixedLoopLength)
                            ]
                            []
                        , case params.shortPiece.loops.style of
                            Simple ->
                                g [] []

                            Folded ->
                                g
                                    [ fill "none"
                                    , stroke "currentColor"
                                    , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                                    , strokeDasharray "1 0.5"
                                    ]
                                    [ Svg.path
                                        [ Path.d
                                            [ MoveTo Absolute ( p.x, p.y + toMM width / 2 )
                                            , HorizontalLineTo Relative size.width
                                            ]
                                        ]
                                        []
                                    , Svg.path
                                        [ Path.d
                                            [ MoveTo Absolute ( p.x, p.y + toMM width * 1.5 )
                                            , HorizontalLineTo Relative size.width
                                            ]
                                        ]
                                        []
                                    ]
                        ]
            }
        )
        params.shortPiece.loops.fixed


freeLoop : Parameters -> Maybe Key -> Maybe (Item msg)
freeLoop params highlighting =
    Maybe.map
        (\{ width, length, overlap } ->
            { size =
                { width = Exactly (toMM length + toMM overlap)
                , height =
                    Exactly
                        (case params.shortPiece.loops.style of
                            Simple ->
                                toMM width

                            Folded ->
                                toMM width * 2
                        )
                }
            , element =
                \p size ->
                    g
                        []
                        [ Svg.path
                            [ Path.d
                                [ MoveTo Absolute ( p.x, p.y )
                                , HorizontalLineTo Relative size.width
                                , VerticalLineTo Relative size.height
                                , HorizontalLineTo Relative -size.width
                                , ClosePath
                                ]
                            , fill "none"
                            , stroke "currentColor"
                            , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                            , highlightStroke
                                (highlighting
                                    == Just FreeLoopWidth
                                    || highlighting
                                    == Just FreeLoopLength
                                    || highlighting
                                    == Just FreeLoopOverlap
                                )
                            ]
                            []
                        , g
                            [ fill "none"
                            , stroke "currentColor"
                            , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                            , strokeDasharray "1 0.5"
                            ]
                            [ Svg.path
                                [ Path.d
                                    [ MoveTo Absolute ( p.x + toMM overlap, p.y )
                                    , VerticalLineTo Relative size.height
                                    ]
                                ]
                                []
                            , Svg.path
                                [ Path.d
                                    [ MoveTo Absolute ( p.x + size.width - toMM overlap, p.y )
                                    , VerticalLineTo Relative size.height
                                    ]
                                ]
                                []
                            ]
                        , case params.shortPiece.loops.style of
                            Simple ->
                                g [] []

                            Folded ->
                                g
                                    [ fill "none"
                                    , stroke "currentColor"
                                    , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                                    , strokeDasharray "1 0.5"
                                    ]
                                    [ Svg.path
                                        [ Path.d
                                            [ MoveTo Absolute ( p.x, p.y + toMM width / 2 )
                                            , HorizontalLineTo Relative size.width
                                            ]
                                        ]
                                        []
                                    , Svg.path
                                        [ Path.d
                                            [ MoveTo Absolute ( p.x, p.y + toMM width * 1.5 )
                                            , HorizontalLineTo Relative size.width
                                            ]
                                        ]
                                        []
                                    ]
                        ]
            }
        )
        params.shortPiece.loops.free


paddings : Parameters -> Maybe Key -> Item msg
paddings params highlighting =
    let
        offset =
            toMM params.paddingOffset

        narrowestWidth =
            case params.profile of
                Straight ->
                    toMM params.shoulderWidth

                Tapered to ->
                    toMM to
    in
    if offset == 0 || (offset * 2) >= narrowestWidth then
        Item { width = Exactly 0, height = Exactly 0 } (\_ _ -> g [] [])

    else
        rows
            |> aligned Container.Center
            |> gapped (toMM params.rendering.gap / 2)
            |> Container.build
                [ Item
                    { width = Exactly 21, height = Exactly 5 }
                    (\p size ->
                        text_
                            [ x (String.fromFloat (p.x + size.width / 2))
                            , y (String.fromFloat p.y)
                            , fontSize (String.fromFloat size.height)
                            , fontWeight "100"
                            , textAnchor "middle"
                            , dominantBaseline "hanging"
                            , fill "currentColor"
                            ]
                            [ text "Paddings" ]
                    )
                , columns
                    |> gapped (toMM params.rendering.gap)
                    |> Container.build
                        [ Item
                            { width = Exactly (toMM params.shoulderWidth - offset * 2)
                            , height = Exactly (toMM params.longPiece.length - offset)
                            }
                            (\p _ ->
                                longPieceShape
                                    { x = p.x
                                    , y = p.y
                                    , offset = offset
                                    , parameters = params
                                    , highlighting = highlighting
                                    }
                            )
                        , Item
                            { width = Exactly (toMM params.shoulderWidth - offset * 2)
                            , height = Exactly (toMM params.shortPiece.length - offset)
                            }
                            (\p _ ->
                                shortPieceShape
                                    { x = p.x
                                    , y = p.y
                                    , offset = offset
                                    , parameters = params
                                    , highlighting = highlighting
                                    }
                            )
                        ]
                ]