Draw strap outer shape without flaps As a foundation code for the template drawing.

Changes

9 changed files (+637/-8)

• build.zig
  • @@ -24,7 +24,12 @@ const compile = Elm.init(b, .{
    .optimize = optimize, }); - compile.addElmSourceFile(b.path("src/Main.elm")); + compile.addMainElmSourceFile(b.path("src/Main.elm")); + + compile.addElmSourceFile(b.path("src/Length.elm")); + compile.addElmSourceFile(b.path("src/Parameters.elm")); + compile.addElmSourceFile(b.path("src/Template.elm")); + compile.addElmSourceFile(b.path("src/Svg/Path.elm")); break :elm_main compile.output_js; };
• build/Elm.zig
  • @@ -49,9 +49,12 @@ .output_js = minified_js,
    }; } } + /// Add main module. + pub fn addMainElmSourceFile(self: Elm, path: std.Build.LazyPath) void { + self.elm_make.addFileArg(path); + } - /// Add Elm source code file. You have to add every source files directly or indirectly imported - /// by a main module. + /// Add non-main Elm source code file. You have to call this for every source files but main module. pub fn addElmSourceFile(self: Elm, path: std.Build.LazyPath) void { - self.elm_make.addFileArg(path); + self.elm_make.addFileInput(path); }
• elm.json
  • @@ -9,6 +9,7 @@ "direct": {
    "elm/browser": "1.0.2", "elm/core": "1.0.5", "elm/html": "1.0.1", + "elm/svg": "1.0.1", "elm/url": "1.0.0" }, "indirect": {
• src/Length.elm (new)
  • @@ -0,0 +1,26 @@
    + -- 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 Length exposing (Length, mm, toMM) + + + type Length + = Millimeter Float + + + mm : Float -> Length + mm = + Millimeter + + + toMM : Length -> Float + toMM x = + case x of + Millimeter n -> + n
• src/Main.elm
  • @@ -11,7 +11,8 @@ module Main exposing (main)
    import Browser import Browser.Navigation exposing (Key) - import Html exposing (node, text) + import Parameters exposing (Parameters) + import Template exposing (template) import Url exposing (Url)
  • @@ -42,12 +43,13 @@
    type alias Model = { url : Url , key : Key + , parameters : Parameters } init : Flags -> Url -> Key -> ( Model, Cmd Msg ) init _ url key = - ( { url = url, key = key }, Cmd.none ) + ( { url = url, key = key, parameters = Parameters.default }, Cmd.none )
  • @@ -81,9 +83,11 @@ -- VIEW
    view : Model -> Browser.Document Msg - view _ = + view model = { title = "" - , body = [ node "x-text" [] [ text "Hello, World!" ] ] + , body = + [ template model.parameters + ] }
• src/Parameters.elm (new)
  • @@ -0,0 +1,124 @@
    + -- 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 Parameters exposing (..) + + import Length exposing (Length, mm) + + + type TipShape + = Round + + + type Profile + = Straight + + + type alias BuckleHole = + -- Offset from the case side (lug side.) + { offset : Length + + -- Number of buckle holes, can be 0. + , count : Int + + -- Center-to-center. + , interval : Length + + -- TODO: Support non circular holes. + , diameter : Length + } + + + {-| Parameters for the long piece, which has buckle holes. + This does not have to be longer than `ShortPiece`. + -} + type alias LongPiece = + { length : Length + , tip : TipShape + , buckleHole : BuckleHole + } + + + type alias FixedLoop = + { width : Length + , play : Length + , offset : Length + } + + + type alias FreeLoop = + { width : Length + , play : Length + } + + + {-| Parameters for the short piece, which has clasp at the end. + This does not have to be shorter than `LongPiece`. + -} + type alias ShortPiece = + { length : Length + , fixedLoop : Maybe FixedLoop + , freeLoop : Maybe FreeLoop + } + + + type CanvasSize + = A4 + + + canvasSizeDimension : CanvasSize -> ( Length, Length ) + canvasSizeDimension size = + case size of + A4 -> + ( mm 210, mm 297 ) + + + type alias Parameters = + { lugWidth : Length + , longPiece : LongPiece + , shortPiece : ShortPiece + , profile : Profile + , thickness : Length + , lining : Maybe Length + , canvasSize : CanvasSize + } + + + default : Parameters + default = + { lugWidth = mm 20 + , longPiece = + { length = mm 112 + , tip = Round + , buckleHole = + { offset = mm 50 + , count = 7 + , interval = mm 6 + , diameter = mm 3 + } + } + , shortPiece = + { length = mm 80 + , fixedLoop = + Just + { offset = mm 8 + , width = mm 6 + , play = mm 1 + } + , freeLoop = + Just + { width = mm 5 + , play = mm 2 + } + } + , profile = Straight + , thickness = mm 2.5 + , lining = Just (mm 0.5) + , canvasSize = A4 + }
• src/Svg/Path.elm (new)
  • @@ -0,0 +1,260 @@
    + -- 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 Svg.Path exposing (LargeArcFlag(..), PathCommand(..), PointMode(..), SweepFlag(..), d) + + import Svg + import Svg.Attributes + + + type PointMode + = Relative + | Absolute + + + type alias PointXY = + ( Float, Float ) + + + pointXY : PointXY -> String + pointXY ( x, y ) = + String.fromFloat x ++ "," ++ String.fromFloat y + + + type alias PointX = + Float + + + type alias PointY = + Float + + + type LargeArcFlag + = LargeArc + | SmallArc + + + largeArcFlag : LargeArcFlag -> String + largeArcFlag flag = + case flag of + LargeArc -> + "1" + + SmallArc -> + "0" + + + type SweepFlag + = Clockwise + | Counterclockwise + + + sweepFlag : SweepFlag -> String + sweepFlag flag = + case flag of + Clockwise -> + "1" + + Counterclockwise -> + "0" + + + type alias EllipticalArcCurveParameters = + { rx : Float + , ry : Float + , angle : Float + , largeArcFlag : LargeArcFlag + , sweepFlag : SweepFlag + , x : Float + , y : Float + } + + + ellipticalArcCurveParamsToString : EllipticalArcCurveParameters -> String + ellipticalArcCurveParamsToString params = + String.fromFloat params.rx + ++ " " + ++ String.fromFloat params.ry + ++ " " + ++ String.fromFloat params.angle + ++ " " + ++ largeArcFlag params.largeArcFlag + ++ " " + ++ sweepFlag params.sweepFlag + ++ " " + ++ String.fromFloat params.x + ++ "," + ++ String.fromFloat params.y + + + type PathCommand + = MoveTo PointMode PointXY + | LineTo PointMode PointXY + | HorizontalLineTo PointMode PointX + | VerticalLineTo PointMode PointY + | CubicBezierCurve PointMode ( PointXY, PointXY, PointXY ) (List ( PointXY, PointXY, PointXY )) + | SmoothCubicBezierCurve PointMode ( PointXY, PointXY ) (List ( PointXY, PointXY )) + | QuadraticBezierCurve PointMode ( PointXY, PointXY ) (List ( PointXY, PointXY )) + | SmoothQuadraticBezierCurve PointMode PointXY (List PointXY) + | EllipticalArcCurve PointMode EllipticalArcCurveParameters (List EllipticalArcCurveParameters) + | ClosePath + + + pointsToString2 : ( PointXY, PointXY ) -> String + pointsToString2 ( p1, p2 ) = + pointXY p1 ++ " " ++ pointXY p2 + + + pointsToString3 : ( PointXY, PointXY, PointXY ) -> String + pointsToString3 ( p1, p2, p3 ) = + pointXY p1 ++ " " ++ pointXY p2 ++ " " ++ pointXY p3 + + + pathCommandToString : PathCommand -> String + pathCommandToString command = + case command of + MoveTo mode p -> + let + op = + case mode of + Absolute -> + "M" + + Relative -> + "m" + in + op ++ " " ++ pointXY p + + LineTo mode p -> + let + op = + case mode of + Absolute -> + "L" + + Relative -> + "l" + in + op ++ " " ++ pointXY p + + HorizontalLineTo mode x -> + let + op = + case mode of + Absolute -> + "H" + + Relative -> + "h" + in + op ++ " " ++ String.fromFloat x + + VerticalLineTo mode y -> + let + op = + case mode of + Absolute -> + "V" + + Relative -> + "v" + in + op ++ " " ++ String.fromFloat y + + CubicBezierCurve mode ps params -> + let + op = + case mode of + Absolute -> + "C" + + Relative -> + "c" + in + (op + :: pointsToString3 ps + :: (params |> List.map pointsToString3 |> List.foldr (::) []) + ) + |> String.join " " + + SmoothCubicBezierCurve mode ps params -> + let + op = + case mode of + Absolute -> + "S" + + Relative -> + "S" + in + (op + :: pointsToString2 ps + :: (params |> List.map pointsToString2 |> List.foldr (::) []) + ) + |> String.join " " + + QuadraticBezierCurve mode ps params -> + let + op = + case mode of + Absolute -> + "Q" + + Relative -> + "q" + in + (op + :: pointsToString2 ps + :: (params |> List.map pointsToString2 |> List.foldr (::) []) + ) + |> String.join " " + + SmoothQuadraticBezierCurve mode p params -> + let + op = + case mode of + Absolute -> + "T" + + Relative -> + "t" + in + (op + :: pointXY p + :: (params |> List.map pointXY |> List.foldr (::) []) + ) + |> String.join " " + + EllipticalArcCurve mode param params -> + let + op = + case mode of + Absolute -> + "A" + + Relative -> + "a" + in + (op + :: ellipticalArcCurveParamsToString param + :: (params |> List.map ellipticalArcCurveParamsToString |> List.foldr (::) []) + ) + |> String.join " " + + ClosePath -> + "Z" + + + d : List PathCommand -> Svg.Attribute msg + d commands = + Svg.Attributes.d + (commands + |> List.map pathCommandToString + |> String.join " " + )
• src/Template.elm (new)
  • @@ -0,0 +1,168 @@
    + -- 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 -> Svg.Svg msg + template params = + 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" + ] + -- TODO: Make margin configurable + [ scaleChecker (BottomLeft ( 10, canvasHeight - 10 )) + , 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" ] + ] + + + longPiece : Parameters -> Anchor -> Svg msg + longPiece params anchor = + let + lugWidth = + toMM params.lugWidth + + length = + toMM params.longPiece.length + + ( ox, oy ) = + topLeftFor anchor ( ceiling lugWidth, ceiling length ) + in + g + [] + [ g + [ fill "none", stroke "currentColor", strokeWidth "0.3" ] + [ Svg.path + [ Svg.Path.d + [ MoveTo Absolute ( toFloat ox, toFloat oy ) + , VerticalLineTo Relative (length - lugWidth) + , EllipticalArcCurve Relative + { rx = lugWidth / 2 + , ry = lugWidth / 2 + , angle = 0.0 + , largeArcFlag = LargeArc + , sweepFlag = Counterclockwise + , x = lugWidth + , y = 0 + } + [] + , VerticalLineTo Relative -(length - lugWidth) + , ClosePath + ] + ] + [] + ] + ] + + + shortPiece : Parameters -> Anchor -> Svg msg + shortPiece params anchor = + let + lugWidth = + toMM params.lugWidth + + length = + toMM params.shortPiece.length + + ( ox, oy ) = + topLeftFor anchor ( ceiling lugWidth, ceiling length ) + in + g + [] + [ g + [ fill "none", stroke "currentColor", strokeWidth "0.3" ] + [ Svg.path + [ Svg.Path.d + [ MoveTo Absolute ( toFloat ox, toFloat oy ) + , VerticalLineTo Relative length + , HorizontalLineTo Relative lugWidth + , VerticalLineTo Relative -length + , ClosePath + ] + ] + [] + ] + ]
• src/index.html
  • @@ -20,5 +20,43 @@ import("./elements.js").then(() => {
    Elm.Main.init(); }); </script> + <style> + .print { + position: absolute; + inset: 0; + margin: auto; + height: 90dvh; + border: 1px solid #0002; + + border-radius: 2px; + box-shadow: 1px 1px 5px #0003; + } + + @media print { + @page { + size: A4; + margin: 0; + } + + :root, body { + margin: 0; + padding: 0; + } + + body > :not(.print) { + display: none !important; + } + + .print { + position: fixed; + inset: 0; + width: 100%; + height: 100%; + + background-color: white; + color: black; + } + } + </style> </head> </html>