/src/Models/PWS01/Template/Cuts.elm at 753cb32c832baa54e714b73cbe15a656c7f439e4

-- Copyright 2026 Shota FUJI
--
-- This source code and the design it expresses are licensed under
-- the Creative Commons Attribution 4.0 International License.
--
-- SPDX-License-Identifier: CC-BY-4.0


module Models.PWS01.Template.Cuts exposing (cuts)

import Html.Attributes exposing (attribute)
import Length exposing (Length, toMM)
import Models.PWS01.Parameters exposing (LoopStyle(..), Parameters, Profile(..), TipStyle(..))
import Models.PWS01.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)
                |> Container.build
                    [ surfacePieces params highlighting |> noGrow
                    , liningPieces 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 "Top pieces" ]
                )
            , columns
                |> gapped (toMM params.rendering.gap)
                |> Container.build
                    [ tailPiece
                        { offset = 0
                        , highlighting = highlighting
                        , parameters = params
                        , renderFlap = True
                        , renderHoles = True
                        }
                    , headPiece
                        { offset = 0
                        , parameters = params
                        , highlighting = highlighting
                        , renderFlaps = True
                        }
                    ]
            ]


liningPieces : Parameters -> Maybe Key -> Item msg
liningPieces params highlighting =
    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 "Linings" ]
                )
            , columns
                |> gapped (toMM params.rendering.gap)
                |> Container.build
                    [ tailPiece
                        { offset = 0
                        , highlighting = highlighting
                        , parameters = params
                        , renderFlap = False
                        , renderHoles = True
                        }
                    , headPiece
                        { offset = 0
                        , parameters = params
                        , highlighting = highlighting
                        , renderFlaps = False
                        }
                    ]
            ]


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


type alias TailPieceProps =
    { offset : Float
    , highlighting : Maybe Key
    , parameters : Parameters
    , renderFlap : Bool
    , renderHoles : Bool
    }


tailPieceGraphicId : TailPieceProps -> String
tailPieceGraphicId { offset, renderFlap, renderHoles } =
    [ "tail"
    , offset * 100 |> ceiling |> String.fromInt
    , if renderFlap then
        "flap"

      else
        "noflap"
    , if renderHoles then
        "holes"

      else
        "noholes"
    ]
        |> String.join "__"


tailPiece : TailPieceProps -> Item msg
tailPiece props =
    let
        { offset, highlighting, parameters, renderFlap, renderHoles } =
            props

        shoulderWidth =
            toMM parameters.shoulderWidth

        length =
            toMM parameters.longPiece.length

        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

        buckleWidth =
            shoulderWidth - taper

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

                Pointed _ ->
                    buckleWidth

        flap =
            if renderFlap then
                toMM parameters.caseSideFlap

            else
                0.0

        localId : String -> String
        localId body =
            tailPieceGraphicId props ++ "__" ++ body
    in
    { size =
        { width = Exactly (shoulderWidth - offset * 2)
        , height = Exactly (length - offset + flap)
        }
    , element =
        \{ x, y } _ ->
            Svg.g
                []
                [ defs
                    []
                    [ Svg.path
                        [ id (localId "body")
                        , Path.d
                            (MoveTo Absolute ( x - offset, y - offset )
                                :: VerticalLineTo Relative flap
                                :: VerticalLineTo Relative offset
                                :: 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 )
                                   , VerticalLineTo Relative -offset
                                   , VerticalLineTo Relative -flap
                                   , ClosePath
                                   ]
                            )
                        ]
                        []
                    ]
                , if offset > 0 then
                    g
                        []
                        [ Svg.mask [ id (localId "mask"), attribute "mask-type" "luminance" ]
                            [ use
                                [ attribute "href" ("#" ++ localId "body")
                                , stroke "black"
                                , strokeWidth (offset * 2 |> String.fromFloat)
                                , fill "white"
                                ]
                                []
                            ]
                        , use
                            [ attribute "href" ("#" ++ localId "body")
                            , Svg.Attributes.mask ("url(#" ++ localId "mask" ++ ")")
                            , fill "none"
                            , stroke "currentColor"
                            , strokeWidth (offset * 2 + toMM parameters.rendering.lineWidth * 2 |> String.fromFloat)
                            ]
                            []
                        ]

                  else
                    use
                        [ attribute "href" ("#" ++ localId "body")
                        , 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 - offset, y )
                        , VerticalLineTo Relative (length - offset + flap)
                        ]
                        :: highlightStroke (highlighting == Just LongPieceLength)
                        :: guideStroke
                    )
                    []
                , if renderFlap then
                    Svg.path
                        (Path.d
                            [ MoveTo Absolute ( x + offset, y + flap )
                            , HorizontalLineTo Relative shoulderWidth
                            ]
                            :: guideStroke
                        )
                        []

                  else
                    g [] []
                , case parameters.longPiece.tip of
                    Round ->
                        g
                            []
                            []

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

                    Tapered _ ->
                        Svg.path
                            (Path.d
                                [ MoveTo Absolute ( x + taper / 2, y + taperUntil + flap )
                                , HorizontalLineTo Relative (buckleWidth - offset * 2)
                                ]
                                :: highlightStroke
                                    (highlighting
                                        == Just ShoulderWidth
                                        || highlighting
                                        == Just TaperTo
                                        || highlighting
                                        == Just BuckleHoleDistance
                                        || highlighting
                                        == Just BuckleHoleAdjustments
                                        || highlighting
                                        == Just BuckleHoleInterval
                                        || highlighting
                                        == Just BuckleHoleDiameter
                                    )
                                :: guideStroke
                            )
                            []
                , if renderHoles then
                    g
                        []
                        (List.range 0 (parameters.longPiece.buckleHole.adjustments * 2)
                            |> List.map
                                (\index ->
                                    let
                                        { buckleHole } =
                                            parameters.longPiece

                                        distance =
                                            toMM buckleHole.distance

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

                  else
                    g [] []
                ]
    }


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 HeadPieceProps =
    { offset : Float
    , highlighting : Maybe Key
    , parameters : Parameters
    , renderFlaps : Bool
    }


headPieceGraphicId : HeadPieceProps -> String
headPieceGraphicId { offset, renderFlaps } =
    [ "head"
    , offset * 100 |> ceiling |> String.fromInt
    , if renderFlaps then
        "flap"

      else
        "noflap"
    ]
        |> String.join "__"


headPiece : HeadPieceProps -> Item msg
headPiece props =
    let
        { offset, highlighting, parameters, renderFlaps } =
            props

        shoulderWidth =
            toMM parameters.shoulderWidth

        length =
            toMM parameters.shortPiece.length

        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

        caseFlap =
            if renderFlaps then
                toMM parameters.caseSideFlap

            else
                0.0

        buckleFlap =
            if renderFlaps then
                toMM parameters.shortPiece.buckleSideFlap

            else
                0.0

        localId : String -> String
        localId body =
            headPieceGraphicId props ++ "__" ++ body
    in
    { size =
        { width = Exactly (shoulderWidth - offset * 2)
        , height = Exactly (length + caseFlap + buckleFlap)
        }
    , element =
        \{ x, y } _ ->
            g
                []
                [ defs []
                    [ Svg.path
                        [ id (localId "body")
                        , Path.d
                            [ MoveTo Absolute ( x - offset, y - offset )
                            , VerticalLineTo Relative caseFlap
                            , VerticalLineTo Relative offset
                            , LineTo Relative ( taper / 2, taperUntil )
                            , VerticalLineTo Relative (length - taperUntil)
                            , VerticalLineTo Relative offset
                            , VerticalLineTo Relative buckleFlap
                            , HorizontalLineTo Relative (shoulderWidth - taper)
                            , VerticalLineTo Relative -buckleFlap
                            , VerticalLineTo Relative -offset
                            , VerticalLineTo Relative -(length - taperUntil)
                            , LineTo Relative ( taper / 2, -taperUntil )
                            , VerticalLineTo Relative -offset
                            , VerticalLineTo Relative -caseFlap
                            , ClosePath
                            ]
                        ]
                        []
                    ]
                , if offset > 0 then
                    g
                        []
                        [ Svg.mask [ id (localId "mask"), attribute "mask-type" "luminance" ]
                            [ use
                                [ attribute "href" ("#" ++ localId "body")
                                , stroke "black"
                                , strokeWidth (offset * 2 |> String.fromFloat)
                                , fill "white"
                                ]
                                []
                            ]
                        , use
                            [ attribute "href" ("#" ++ localId "body")
                            , Svg.Attributes.mask ("url(#" ++ localId "mask" ++ ")")
                            , fill "none"
                            , stroke "currentColor"
                            , strokeWidth (offset * 2 + toMM parameters.rendering.lineWidth * 2 |> String.fromFloat)
                            ]
                            []
                        ]

                  else
                    use
                        [ attribute "href" ("#" ++ localId "body")
                        , 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 - offset, y )
                        , VerticalLineTo Relative (length + caseFlap + buckleFlap)
                        ]
                        :: highlightStroke (highlighting == Just ShortPieceLength)
                        :: guideStroke
                    )
                    []
                , if renderFlaps then
                    g
                        []
                        [ Svg.path
                            (Path.d
                                [ MoveTo Absolute ( x, y + caseFlap )
                                , HorizontalLineTo Relative shoulderWidth
                                ]
                                :: guideStroke
                            )
                            []
                        , Svg.path
                            (Path.d
                                [ MoveTo Absolute ( x + taper / 2, y + length + caseFlap )
                                , HorizontalLineTo Relative (shoulderWidth - taper - offset * 2)
                                ]
                                :: guideStroke
                            )
                            []
                        ]

                  else
                    g [] []
                , case parameters.profile of
                    Straight ->
                        g [] []

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


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
                        [ tailPiece
                            { offset = offset
                            , parameters = params
                            , highlighting = highlighting
                            , renderFlap = False
                            , renderHoles = False
                            }
                        , headPiece
                            { offset = offset
                            , parameters = params
                            , highlighting = highlighting
                            , renderFlaps = False
                            }
                        ]
                ]