/src/Template.elm at 3ed7e6712154b6379e7ecd15db46bdfdeabecce6

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


topLeftFor : Anchor -> ( Float, Float ) -> ( 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.canvas.size
                |> Tuple.mapBoth toMM toMM

        margin =
            toMM params.canvas.margin
    in
    svg
        (viewBox (String.join " " [ "0", "0", String.fromInt (ceiling canvasWidth), String.fromInt (ceiling canvasHeight) ])
            :: class "print"
            :: attrs
        )
        [ scaleChecker (BottomLeft ( margin, 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 ( toMM params.lugWidth + margin + 10, margin ))
        ]


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

        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" ]
        ]


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


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 ( lugWidth, length )
    in
    g
        []
        (Svg.path
            [ Svg.Path.d
                [ MoveTo Absolute ( ox, oy )
                , VerticalLineTo Relative (length + flap - lugWidth)
                , EllipticalArcCurve Relative
                    { rx = lugWidth / 2
                    , ry = lugWidth / 2
                    , angle = 0.0
                    , largeArcFlag = LargeArc
                    , sweepFlag = Counterclockwise
                    , x = lugWidth
                    , y = 0
                    }
                    []
                , VerticalLineTo Relative -(length + flap - lugWidth)
                , ClosePath
                ]
            , fill "none"
            , stroke "currentColor"
            , strokeWidth "0.3"
            ]
            []
            :: Svg.path
                (Svg.Path.d
                    [ MoveTo Absolute ( ox, oy + flap )
                    , HorizontalLineTo Relative lugWidth
                    ]
                    :: skivingSeamStroke
                )
                []
            :: 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
                                buckleHole.diameter
                                ( ox + lugWidth / 2
                                , oy + offset + interval * toFloat index
                                )
                        )
               )
        )


hole : Length -> ( Float, Float ) -> Svg msg
hole 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 "0.3"
            ]
            []
        , 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
                    ]
                ]
                []
            ]
        ]


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 ( lugWidth, length )
    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 "0.3"
            ]
            []
        , g
            skivingSeamStroke
            [ 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
                    ]
                ]
                []
            ]
        ]