/src/Template.elm at 3c39b2a82588021863589435a660d3accd446088

-- 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 (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 ( Int, Int )
    | TopRight ( Int, Int )
    | BottomLeft ( Int, Int )
    | BottomRight ( Int, Int )


topLeftFor : Anchor -> ( Int, Int ) -> ( Int, Int )
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.canvasSize
                |> Tuple.mapBoth toMM toMM
                |> Tuple.mapBoth ceiling ceiling
    in
    svg
        (viewBox (String.join " " [ "0", "0", String.fromInt canvasWidth, String.fromInt canvasHeight ])
            :: class "print"
            :: attrs
        )
        -- TODO: Make margin configurable
        [ scaleChecker (BottomLeft ( 10, canvasHeight - 10 ))
        , 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 ( 10, 10 ))
        , shortPiece params (TopLeft ( ceiling (toMM params.lugWidth) + 20, 10 ))
        ]


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

        px : Int -> String
        px n =
            String.fromInt (ox + n)

        py : Int -> String
        py n =
            String.fromInt (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 ( ceiling lugWidth, ceiling length )
    in
    g
        []
        [ Svg.path
            [ Svg.Path.d
                [ MoveTo Absolute ( toFloat ox, toFloat 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 ( toFloat ox, toFloat oy + flap )
                , HorizontalLineTo Relative lugWidth
                ]
                :: skivingSeamStroke
            )
            []
        , Svg.path
            [ Svg.Path.d
                [ MoveTo Absolute ( toFloat ox, toFloat oy )
                , HorizontalLineTo Relative lugWidth
                , VerticalLineTo Relative flap
                , HorizontalLineTo Relative -lugWidth
                , ClosePath
                ]
            , fill "url(#SkivingPattern)"
            ]
            []
        ]


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