/src/Template.elm at 4b31642ff6bd995783237119a6504f05d201d615

-- 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 exposing (template)

import Length exposing (Length, toMM)
import Parameters exposing (Parameters, canvasSizeDimension)
import String
import Svg exposing (..)
import Svg.Attributes exposing (..)
import Svg.Path exposing (LargeArcFlag(..), PathCommand(..), PointMode(..), SweepFlag(..))


type Anchor
    = TopLeft ( Float, Float )
    | TopRight ( Float, Float )
    | BottomLeft ( Float, Float )
    | BottomRight ( Float, Float )


type alias Size =
    { width : Float, height : Float }


topLeftFor : Anchor -> Size -> ( Float, Float )
topLeftFor anchor { width, height } =
    case anchor of
        TopLeft ( x, y ) ->
            ( x, y )

        TopRight ( x, y ) ->
            ( x - width, y )

        BottomLeft ( x, y ) ->
            ( x, y - height )

        BottomRight ( x, y ) ->
            ( x - width, y - height )


template : Parameters -> List (Svg.Attribute msg) -> Svg.Svg msg
template params attrs =
    let
        ( canvasWidth, canvasHeight ) =
            canvasSizeDimension params.rendering.size
                |> Tuple.mapBoth toMM toMM

        margin =
            toMM params.rendering.margin

        lugWidth =
            toMM params.lugWidth

        gap =
            toMM params.rendering.gap
    in
    svg
        (viewBox (String.join " " [ "0", "0", String.fromInt (ceiling canvasWidth), String.fromInt (ceiling canvasHeight) ])
            :: class "print"
            :: attrs
        )
        [ scaleChecker (BottomLeft ( margin, canvasHeight - margin ))
        , legends params (BottomLeft ( margin + scaleCheckerSize.width + 10, canvasHeight - margin ))
        , defs
            []
            [ pattern
                [ id "SkivingPattern"
                , x "0"
                , y "0"
                , width "3"
                , height "3"
                , patternUnits "userSpaceOnUse"
                ]
                [ Svg.path
                    [ Svg.Path.d
                        [ MoveTo Absolute ( -1, -1 )
                        , LineTo Absolute ( 4, 4 )
                        ]
                    , fill "none"
                    , stroke "currentColor"
                    , strokeWidth "0.1"
                    , strokeDasharray "1"
                    ]
                    []
                ]
            ]
        , longPiece params (TopLeft ( margin, margin ))
        , shortPiece params (TopLeft ( margin + lugWidth + gap, margin ))
        , linings params (TopRight ( canvasWidth - margin, margin ))
        ]


scaleCheckerSize : Size
scaleCheckerSize =
    Size 10 10


scaleChecker : Anchor -> Svg msg
scaleChecker anchor =
    let
        ( ox, oy ) =
            topLeftFor anchor scaleCheckerSize

        px : Float -> String
        px n =
            String.fromFloat (ox + n)

        py : Float -> String
        py n =
            String.fromFloat (oy + n)
    in
    g
        []
        [ g
            [ stroke "currentColor", strokeWidth "0.2" ]
            [ line
                [ x1 (px 0), y1 (py 8), x2 (px 0), y2 (py 10) ]
                []
            , line
                [ x1 (px 0), y1 (py 9), x2 (px 10), y2 (py 9) ]
                []
            , line
                [ x1 (px 10), y1 (py 8), x2 (px 10), y2 (py 10) ]
                []
            ]
        , text_
            [ x (px 5)
            , y (py 7)
            , fontSize "3"
            , fontWeight "100"
            , textAnchor "middle"
            , fill "currentColor"
            ]
            [ text "10mm" ]
        ]


legendsSize : Size
legendsSize =
    Size 34 23


legends : Parameters -> Anchor -> Svg msg
legends params anchor =
    let
        ( ox, oy ) =
            topLeftFor anchor legendsSize

        px : Float -> String
        px n =
            String.fromFloat (ox + n)

        py : Float -> String
        py n =
            String.fromFloat (oy + n)
    in
    g
        []
        [ Svg.path
            [ Svg.Path.d
                [ MoveTo Absolute ( ox, oy + 5 )
                , HorizontalLineTo Relative 8
                ]
            , stroke "currentColor"
            , strokeWidth (params.rendering.lineWidth |> toMM |> String.fromFloat)
            ]
            []
        , text_
            [ x (px 10)
            , y (py 6)
            , fontSize "4"
            , fontWeight "100"
            , textAnchor "left"
            , fill "currentColor"
            ]
            [ text "Cut line" ]
        , rect
            [ x (px 0)
            , y (py 10)
            , stroke "currentColor"
            , width "8"
            , height "5"
            , strokeWidth "0.2"
            , fill "url(#SkivingPattern)"
            ]
            []
        , text_
            [ x (px 10)
            , y (py 14)
            , fontSize "4"
            , fontWeight "100"
            , textAnchor "left"
            , fill "currentColor"
            ]
            [ text "Skiving area" ]
        , g
            [ fill "none"
            , stroke "currentColor"
            , strokeWidth "0.1"
            ]
            [ Svg.path
                [ Svg.Path.d
                    [ MoveTo Absolute ( ox + 1.5, oy + 20.5 )
                    , HorizontalLineTo Relative 5
                    ]
                ]
                []
            , Svg.path
                [ Svg.Path.d
                    [ MoveTo Absolute ( ox + 4, oy + 18 )
                    , VerticalLineTo Relative 5
                    ]
                ]
                []
            ]
        , text_
            [ x (px 10)
            , y (py 22)
            , fontSize "4"
            , fontWeight "100"
            , textAnchor "left"
            , fill "currentColor"
            ]
            [ text "Hole center" ]
        ]


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


longPieceSize : Parameters -> Size
longPieceSize params =
    Size (toMM params.lugWidth) (toMM params.longPiece.length + toMM params.longPiece.flap)


longPiece : Parameters -> Anchor -> Svg msg
longPiece params anchor =
    let
        lugWidth =
            toMM params.lugWidth

        length =
            toMM params.longPiece.length

        flap =
            toMM params.longPiece.flap

        ( ox, oy ) =
            topLeftFor anchor (longPieceSize params)
    in
    g
        []
        (Svg.path
            [ Svg.Path.d
                [ MoveTo Absolute ( ox, oy )
                , 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
                (Svg.Path.d
                    [ MoveTo Absolute ( ox, oy + flap )
                    , HorizontalLineTo Relative lugWidth
                    ]
                    :: skivingSeamStroke params
                )
                []
            :: Svg.path
                [ Svg.Path.d
                    [ MoveTo Absolute ( ox, oy )
                    , 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
                                ( ox + lugWidth / 2
                                , oy + 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
                [ Svg.Path.d
                    [ MoveTo Absolute ( cx - radius / 2, cy )
                    , HorizontalLineTo Relative radius
                    ]
                ]
                []
            , Svg.path
                [ Svg.Path.d
                    [ MoveTo Absolute ( cx, cy - radius / 2 )
                    , VerticalLineTo Relative radius
                    ]
                ]
                []
            ]
        ]


shortPieceSize : Parameters -> Size
shortPieceSize params =
    Size (toMM params.lugWidth) (toMM params.shortPiece.length + toMM params.shortPiece.caseSideFlap)


shortPiece : Parameters -> Anchor -> Svg msg
shortPiece params anchor =
    let
        lugWidth =
            toMM params.lugWidth

        length =
            toMM params.shortPiece.length

        caseSideFlap =
            toMM params.shortPiece.caseSideFlap

        claspSideFlap =
            toMM params.shortPiece.claspSideFlap

        ( ox, oy ) =
            topLeftFor anchor (shortPieceSize params)
    in
    g
        []
        [ Svg.path
            [ Svg.Path.d
                [ MoveTo Absolute ( ox, oy )
                , 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
                [ Svg.Path.d
                    [ MoveTo Absolute ( ox, oy + caseSideFlap )
                    , HorizontalLineTo Relative lugWidth
                    ]
                ]
                []
            , Svg.path
                [ Svg.Path.d
                    [ MoveTo Absolute ( ox, oy + caseSideFlap + length )
                    , HorizontalLineTo Relative lugWidth
                    ]
                ]
                []
            ]
        , g
            [ fill "url(#SkivingPattern)" ]
            [ Svg.path
                [ Svg.Path.d
                    [ MoveTo Absolute ( ox, oy )
                    , HorizontalLineTo Relative lugWidth
                    , VerticalLineTo Relative caseSideFlap
                    , HorizontalLineTo Relative -lugWidth
                    , ClosePath
                    ]
                ]
                []
            , Svg.path
                [ Svg.Path.d
                    [ MoveTo Absolute ( ox, oy + caseSideFlap + length )
                    , HorizontalLineTo Relative lugWidth
                    , VerticalLineTo Relative claspSideFlap
                    , HorizontalLineTo Relative -lugWidth
                    , ClosePath
                    ]
                ]
                []
            ]
        ]


linings : Parameters -> Anchor -> Svg msg
linings params anchor =
    if toMM params.lining == 0 then
        g [] []

    else
        let
            gap =
                toMM params.rendering.gap

            lugWidth =
                toMM params.lugWidth

            sectionWidth =
                lugWidth * 2 + gap

            headerHeight =
                5.0

            size =
                Size
                    sectionWidth
                    (headerHeight + gap / 2 + Basics.max (toMM params.longPiece.length) (toMM params.shortPiece.length))

            ( ox, oy ) =
                topLeftFor anchor size
        in
        g
            []
            [ longLining params (TopLeft ( ox, oy + headerHeight + gap / 2 ))
            , shortLining params (TopLeft ( ox + lugWidth + gap, oy + headerHeight + gap / 2 ))
            , text_
                [ x (ox + sectionWidth / 2 |> String.fromFloat)
                , y (oy + 4 |> String.fromFloat)
                , fontSize "5"
                , fontWeight "100"
                , textAnchor "middle"
                , fill "currentColor"
                ]
                [ text ("Linings / t = " ++ (toMM params.lining |> String.fromFloat) ++ "mm") ]
            ]


longLiningSize : Parameters -> Size
longLiningSize params =
    Size (toMM params.lugWidth) (toMM params.longPiece.length)


longLining : Parameters -> Anchor -> Svg msg
longLining params anchor =
    let
        lugWidth =
            toMM params.lugWidth

        length =
            toMM params.longPiece.length

        ( ox, oy ) =
            topLeftFor anchor (longLiningSize params)
    in
    g
        []
        [ Svg.path
            [ Svg.Path.d
                [ MoveTo Absolute ( ox, oy )
                , 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)
            ]
            []
        ]


shortLiningSize : Parameters -> Size
shortLiningSize params =
    Size (toMM params.lugWidth) (toMM params.shortPiece.length)


shortLining : Parameters -> Anchor -> Svg msg
shortLining params anchor =
    let
        lugWidth =
            toMM params.lugWidth

        length =
            toMM params.shortPiece.length

        ( ox, oy ) =
            topLeftFor anchor (shortLiningSize params)
    in
    g
        []
        [ Svg.path
            [ Svg.Path.d
                [ MoveTo Absolute ( ox, oy )
                , VerticalLineTo Relative length
                , HorizontalLineTo Relative lugWidth
                , VerticalLineTo Relative -length
                , ClosePath
                ]
            , fill "none"
            , stroke "currentColor"
            , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
            ]
            []
        ]