/src/Template/Cuts.elm at ad3eb5d20a9d42cec50929529d14d4b1ecb29781

-- 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)
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)


cuts : Parameters -> Item msg
cuts params =
    -- 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
                     , linings params
                     ]
                        |> List.map noGrow
                    )
                |> Just
             , loops params
             ]
                |> List.filterMap identity
                |> List.map noGrow
            )


surfacePieces : Parameters -> Item msg
surfacePieces params =
    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 ("Surfaces / t = " ++ (toMM params.thickness |> String.fromFloat) ++ "mm") ]
                )
            , columns
                |> gapped (toMM params.rendering.gap)
                |> Container.build
                    [ longPiece params, shortPiece params ]
            ]


skivingSeamStroke : Parameters -> List (Svg.Attribute msg)
skivingSeamStroke params =
    [ fill "none"
    , stroke "currentColor"
    , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
    , strokeDasharray "1 0.5"
    ]


longPiece : Parameters -> Item msg
longPiece params =
    let
        lugWidth =
            toMM params.lugWidth

        length =
            toMM params.longPiece.length

        flap =
            toMM params.longPiece.flap
    in
    { size = { width = Exactly lugWidth, height = Exactly (length + flap) }
    , element =
        \p _ ->
            g
                []
                (Svg.path
                    [ Path.d
                        [ MoveTo Absolute ( p.x, p.y )
                        , VerticalLineTo Relative (length + flap - lugWidth / 2)
                        , EllipticalArcCurve Relative
                            { rx = lugWidth / 2
                            , ry = lugWidth / 2
                            , angle = 0.0
                            , largeArcFlag = LargeArc
                            , sweepFlag = Counterclockwise
                            , x = lugWidth
                            , y = 0
                            }
                            []
                        , VerticalLineTo Relative -(length + flap - lugWidth / 2)
                        , ClosePath
                        ]
                    , fill "none"
                    , stroke "currentColor"
                    , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                    ]
                    []
                    :: Svg.path
                        (Path.d
                            [ MoveTo Absolute ( p.x, p.y + flap )
                            , HorizontalLineTo Relative lugWidth
                            ]
                            :: skivingSeamStroke params
                        )
                        []
                    :: Svg.path
                        [ Path.d
                            [ MoveTo Absolute ( p.x, p.y )
                            , HorizontalLineTo Relative lugWidth
                            , VerticalLineTo Relative flap
                            , HorizontalLineTo Relative -lugWidth
                            , ClosePath
                            ]
                        , fill "url(#SkivingPattern)"
                        ]
                        []
                    :: (List.range 0 (params.longPiece.buckleHole.count - 1)
                            |> List.map
                                (\index ->
                                    let
                                        { buckleHole } =
                                            params.longPiece

                                        offset =
                                            toMM buckleHole.offset

                                        interval =
                                            toMM buckleHole.interval
                                    in
                                    hole
                                        params
                                        buckleHole.diameter
                                        ( p.x + lugWidth / 2
                                        , p.y + offset + interval * toFloat index
                                        )
                                )
                       )
                )
    }


hole : Parameters -> Length -> ( Float, Float ) -> Svg msg
hole params diameter ( cx, cy ) =
    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)
            ]
            []
        , 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
                    ]
                ]
                []
            ]
        ]


shortPiece : Parameters -> Item msg
shortPiece params =
    let
        lugWidth =
            toMM params.lugWidth

        length =
            toMM params.shortPiece.length

        caseSideFlap =
            toMM params.shortPiece.caseSideFlap

        claspSideFlap =
            toMM params.shortPiece.claspSideFlap
    in
    { size =
        { width = Exactly lugWidth, height = Exactly (length + caseSideFlap + claspSideFlap) }
    , element =
        \p _ ->
            g
                []
                [ Svg.path
                    [ Path.d
                        [ MoveTo Absolute ( p.x, p.y )
                        , VerticalLineTo Relative (length + caseSideFlap + claspSideFlap)
                        , HorizontalLineTo Relative lugWidth
                        , VerticalLineTo Relative -(length + caseSideFlap + claspSideFlap)
                        , ClosePath
                        ]
                    , fill "none"
                    , stroke "currentColor"
                    , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                    ]
                    []
                , g
                    (skivingSeamStroke params)
                    [ Svg.path
                        [ Path.d
                            [ MoveTo Absolute ( p.x, p.y + caseSideFlap )
                            , HorizontalLineTo Relative lugWidth
                            ]
                        ]
                        []
                    , Svg.path
                        [ Path.d
                            [ MoveTo Absolute ( p.x, p.y + caseSideFlap + length )
                            , HorizontalLineTo Relative lugWidth
                            ]
                        ]
                        []
                    ]
                , g
                    [ fill "url(#SkivingPattern)" ]
                    [ Svg.path
                        [ Path.d
                            [ MoveTo Absolute ( p.x, p.y )
                            , HorizontalLineTo Relative lugWidth
                            , VerticalLineTo Relative caseSideFlap
                            , HorizontalLineTo Relative -lugWidth
                            , ClosePath
                            ]
                        ]
                        []
                    , Svg.path
                        [ Path.d
                            [ MoveTo Absolute ( p.x, p.y + caseSideFlap + length )
                            , HorizontalLineTo Relative lugWidth
                            , VerticalLineTo Relative claspSideFlap
                            , HorizontalLineTo Relative -lugWidth
                            , ClosePath
                            ]
                        ]
                        []
                    ]
                ]
    }


linings : Parameters -> Item msg
linings params =
    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 ("Linings / t = " ++ (toMM params.lining |> String.fromFloat) ++ "mm") ]
                )
            , columns
                |> gapped (toMM params.rendering.gap)
                |> Container.build
                    [ longLining params, shortLining params ]
            ]


longLining : Parameters -> Item msg
longLining params =
    let
        lugWidth =
            toMM params.lugWidth

        length =
            toMM params.longPiece.length
    in
    { size =
        { width = Exactly lugWidth, height = Exactly length }
    , element =
        \p _ ->
            Svg.path
                [ Path.d
                    [ MoveTo Absolute ( p.x, p.y )
                    , VerticalLineTo Relative (length - lugWidth / 2)
                    , EllipticalArcCurve Relative
                        { rx = lugWidth / 2
                        , ry = lugWidth / 2
                        , angle = 0.0
                        , largeArcFlag = LargeArc
                        , sweepFlag = Counterclockwise
                        , x = lugWidth
                        , y = 0
                        }
                        []
                    , VerticalLineTo Relative -(length - lugWidth / 2)
                    , ClosePath
                    ]
                , fill "none"
                , stroke "currentColor"
                , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                ]
                []
    }


shortLining : Parameters -> Item msg
shortLining params =
    let
        lugWidth =
            toMM params.lugWidth

        length =
            toMM params.shortPiece.length
    in
    { size =
        { width = Exactly lugWidth, height = Exactly length }
    , element =
        \p _ ->
            Svg.path
                [ Path.d
                    [ MoveTo Absolute ( p.x, p.y )
                    , VerticalLineTo Relative length
                    , HorizontalLineTo Relative lugWidth
                    , VerticalLineTo Relative -length
                    , ClosePath
                    ]
                , fill "none"
                , stroke "currentColor"
                , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                ]
                []
    }


loops : Parameters -> Maybe (Item msg)
loops params =
    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 / t = " ++ (toMM root.thickness |> String.fromFloat) ++ "mm") ]
                        )
                    , columns
                        |> gapped (toMM params.rendering.gap)
                        |> Container.build
                            ([ fixedLoop params
                             , freeLoop params
                             ]
                                |> List.filterMap identity
                            )
                    ]
                |> Just


fixedLoop : Parameters -> Maybe (Item msg)
fixedLoop params =
    Maybe.map
        (\{ width, play } ->
            let
                strapThickness =
                    toMM params.thickness + toMM params.lining

                lugWidth =
                    toMM params.lugWidth

                length =
                    lugWidth * 2 + strapThickness * 2 + toMM play
            in
            { size =
                { width = Exactly length
                , height =
                    Exactly
                        (case params.shortPiece.loops.style of
                            Simple ->
                                toMM width

                            Folded ->
                                toMM width * 2
                        )
                }
            , element =
                \p size ->
                    let
                        hCutLine : Float -> Svg msg
                        hCutLine yOffset =
                            g
                                [ fill "none"
                                , stroke "currentColor"
                                , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                                ]
                                [ Svg.path
                                    [ Path.d
                                        [ MoveTo Absolute ( p.x, p.y + yOffset )
                                        , HorizontalLineTo Relative lugWidth
                                        ]
                                    ]
                                    []
                                , Svg.path
                                    [ Path.d
                                        [ MoveTo Absolute ( p.x + lugWidth, p.y + yOffset )
                                        , HorizontalLineTo Relative strapThickness
                                        ]
                                    ]
                                    []
                                , Svg.path
                                    [ Path.d
                                        [ MoveTo Absolute ( p.x + lugWidth + strapThickness, p.y + yOffset )
                                        , HorizontalLineTo Relative lugWidth
                                        ]
                                    ]
                                    []
                                , Svg.path
                                    [ Path.d
                                        [ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness, p.y + yOffset )
                                        , HorizontalLineTo Relative strapThickness
                                        ]
                                    ]
                                    []
                                , Svg.path
                                    [ Path.d
                                        [ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness * 2, p.y + yOffset )
                                        , HorizontalLineTo Relative (toMM play)
                                        ]
                                    ]
                                    []
                                ]
                    in
                    g
                        []
                        [ hCutLine 0
                        , hCutLine size.height
                        , case params.shortPiece.loops.style of
                            Simple ->
                                g
                                    [ fill "none"
                                    , stroke "currentColor"
                                    , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                                    ]
                                    [ Svg.path
                                        [ Path.d
                                            [ MoveTo Absolute ( p.x, p.y )
                                            , VerticalLineTo Relative (toMM width)
                                            ]
                                        ]
                                        []
                                    , Svg.path
                                        [ Path.d
                                            [ MoveTo Absolute ( p.x + length, p.y )
                                            , VerticalLineTo Relative (toMM width)
                                            ]
                                        ]
                                        []
                                    ]

                            Folded ->
                                g
                                    []
                                    [ 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 length
                                                ]
                                            ]
                                            []
                                        , Svg.path
                                            [ Path.d
                                                [ MoveTo Absolute ( p.x, p.y + toMM width * 1.5 )
                                                , HorizontalLineTo Relative length
                                                ]
                                            ]
                                            []
                                        ]
                                    , g
                                        [ fill "none"
                                        , stroke "currentColor"
                                        , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                                        ]
                                        [ Svg.path
                                            [ Path.d
                                                [ MoveTo Absolute ( p.x, p.y )
                                                , VerticalLineTo Relative (toMM width * 2)
                                                ]
                                            ]
                                            []
                                        , Svg.path
                                            [ Path.d
                                                [ MoveTo Absolute ( p.x + length, p.y )
                                                , VerticalLineTo Relative (toMM width * 2)
                                                ]
                                            ]
                                            []
                                        ]
                                    ]
                        ]
            }
        )
        params.shortPiece.loops.fixed


freeLoop : Parameters -> Maybe (Item msg)
freeLoop params =
    Maybe.map
        (\{ width, play, overlap } ->
            let
                strapThickness =
                    toMM params.thickness + toMM params.lining

                lugWidth =
                    toMM params.lugWidth

                length =
                    lugWidth * 2 + strapThickness * 2 + toMM play + toMM overlap

                materialWidth =
                    case params.shortPiece.loops.style of
                        Simple ->
                            toMM width

                        Folded ->
                            toMM width * 2
            in
            { size =
                { width = Exactly length, height = Exactly materialWidth }
            , element =
                \p _ ->
                    let
                        hCutLine : Float -> Svg msg
                        hCutLine yOffset =
                            g
                                [ fill "none"
                                , stroke "currentColor"
                                , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                                ]
                                [ Svg.path
                                    [ Path.d
                                        [ MoveTo Absolute ( p.x, p.y + yOffset )
                                        , HorizontalLineTo Relative lugWidth
                                        ]
                                    ]
                                    []
                                , Svg.path
                                    [ Path.d
                                        [ MoveTo Absolute ( p.x + lugWidth, p.y + yOffset )
                                        , HorizontalLineTo Relative strapThickness
                                        ]
                                    ]
                                    []
                                , Svg.path
                                    [ Path.d
                                        [ MoveTo Absolute ( p.x + lugWidth + strapThickness, p.y + yOffset )
                                        , HorizontalLineTo Relative lugWidth
                                        ]
                                    ]
                                    []
                                , Svg.path
                                    [ Path.d
                                        [ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness, p.y + yOffset )
                                        , HorizontalLineTo Relative strapThickness
                                        ]
                                    ]
                                    []
                                , Svg.path
                                    [ Path.d
                                        [ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness * 2, p.y + yOffset )
                                        , HorizontalLineTo Relative (toMM play)
                                        ]
                                    ]
                                    []
                                , Svg.path
                                    [ Path.d
                                        [ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness * 2 + toMM play, p.y + yOffset )
                                        , HorizontalLineTo Relative (toMM overlap)
                                        ]
                                    ]
                                    []
                                ]
                    in
                    g
                        []
                        [ hCutLine 0
                        , hCutLine materialWidth
                        , Svg.path
                            [ Path.d
                                [ MoveTo Absolute ( p.x + toMM overlap, p.y )
                                , VerticalLineTo Relative materialWidth
                                ]
                            , fill "none"
                            , stroke "currentColor"
                            , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                            , strokeDasharray "1 0.5"
                            ]
                            []
                        , case params.shortPiece.loops.style of
                            Simple ->
                                g
                                    [ fill "none"
                                    , stroke "currentColor"
                                    , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                                    ]
                                    [ Svg.path
                                        [ Path.d
                                            [ MoveTo Absolute ( p.x, p.y )
                                            , VerticalLineTo Relative (toMM width)
                                            ]
                                        ]
                                        []
                                    , Svg.path
                                        [ Path.d
                                            [ MoveTo Absolute ( p.x + length, p.y )
                                            , VerticalLineTo Relative (toMM width)
                                            ]
                                        ]
                                        []
                                    ]

                            Folded ->
                                g
                                    []
                                    [ 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 length
                                                ]
                                            ]
                                            []
                                        , Svg.path
                                            [ Path.d
                                                [ MoveTo Absolute ( p.x, p.y + toMM width * 1.5 )
                                                , HorizontalLineTo Relative length
                                                ]
                                            ]
                                            []
                                        ]
                                    , g
                                        [ fill "none"
                                        , stroke "currentColor"
                                        , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
                                        ]
                                        [ Svg.path
                                            [ Path.d
                                                [ MoveTo Absolute ( p.x, p.y )
                                                , VerticalLineTo Relative (toMM width * 2)
                                                ]
                                            ]
                                            []
                                        , Svg.path
                                            [ Path.d
                                                [ MoveTo Absolute ( p.x + length, p.y )
                                                , VerticalLineTo Relative (toMM width * 2)
                                                ]
                                            ]
                                            []
                                        ]
                                    ]
                        ]
            }
        )
        params.shortPiece.loops.free