Use automatic layout system for template drawings The current manual coordination is PITA.

Changes

8 changed files (+1487/-934)

• build.zig
  • @@ -36,6 +36,12 @@ compile.addElmSourceFile(b.path("src/Parameters/Parser.elm"));
    compile.addElmSourceFile(b.path("src/Preferences.elm")); compile.addElmSourceFile(b.path("src/Preferences/App.elm")); compile.addElmSourceFile(b.path("src/Template.elm")); + compile.addElmSourceFile(b.path("src/Template/Cuts.elm")); + compile.addElmSourceFile(b.path("src/Template/InfoArea.elm")); + compile.addElmSourceFile(b.path("src/Template/Layout.elm")); + compile.addElmSourceFile(b.path("src/Template/Layout/Container.elm")); + compile.addElmSourceFile(b.path("src/Template/Layout/Coordinate.elm")); + compile.addElmSourceFile(b.path("src/Template/Layout/Item.elm")); compile.addElmSourceFile(b.path("src/Svg/Path.elm")); break :elm_main compile.output_js;
• src/Template.elm
  • @@ -9,39 +9,17 @@
    module Template exposing (template) - import Length exposing (Length, toMM) + import Length exposing (toMM) import Parameters exposing (LoopStyle(..), 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 ) + import Template.Cuts exposing (cuts) + import Template.InfoArea exposing (infoArea) + import Template.Layout as Layout + import Template.Layout.Container as Container + import Template.Layout.Coordinate exposing (Request(..)) template : Parameters -> List (Svg.Attribute msg) -> Svg.Svg msg
  • @@ -59,9 +37,7 @@ (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 + [ defs [] [ pattern [ id "SkivingPattern"
  • @@ -84,908 +60,14 @@ ]
    [] ] ] - , surfacePieces params (TopLeft ( margin, margin )) - , linings params (TopRight ( canvasWidth - margin, margin )) - - -- TODO: Move below the linings - , loops params (BottomRight ( canvasWidth - margin, canvasHeight - 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" - ] - - - surfacePieces : Parameters -> Anchor -> Svg msg - surfacePieces params anchor = - let - lugWidth = - toMM params.lugWidth - - gap = - toMM params.rendering.gap - - headerHeight = - 5.0 - - sectionWidth = - lugWidth * 2 + gap - - ( ox, oy ) = - topLeftFor anchor - (Size sectionWidth - (headerHeight - + gap - / 2 - + Basics.max - (.height (longPieceSize params)) - (.height (shortPieceSize params)) - ) - ) - in - g - [] - [ longPiece params (TopLeft ( ox, oy + headerHeight + gap / 2 )) - , shortPiece 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 ("Surfaces / t = " ++ (toMM params.thickness |> String.fromFloat) ++ "mm") ] - ] - - - 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 + , Container.rows + |> Container.sized (AtLeast 0) (AtLeast 0) + |> Container.gapped 10 + |> Container.aligned Container.Center + |> Container.padded margin + |> Container.build + [ cuts params + , infoArea params ] - , fill "none" - , stroke "currentColor" - , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat) - ] - [] + |> Layout.render { width = canvasWidth, height = canvasHeight } ] - - - 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) - ] - [] - ] - - - loops : Parameters -> Anchor -> Svg msg - loops params anchor = - let - root = - params.shortPiece.loops - in - if root.fixed == Nothing && root.free == Nothing then - g [] [] - - else - let - gap = - toMM params.rendering.gap - - lugWidth = - toMM params.lugWidth - - strapThickness = - toMM params.thickness + toMM params.lining - - widthModifier = - case root.style of - Simple -> - 1.0 - - Folded -> - 2.0 - - freeLoopLength = - lugWidth - * 2 - + strapThickness - * 2 - + (root.free |> Maybe.map .play |> Maybe.map toMM |> Maybe.withDefault 0) - + (root.free |> Maybe.map .overlap |> Maybe.map toMM |> Maybe.withDefault 0) - - freeLoopWidth = - root.free |> Maybe.map .width |> Maybe.map toMM |> Maybe.withDefault 0 |> (*) widthModifier - - fixedLoopLength = - lugWidth * 2 + strapThickness * 2 + (root.fixed |> Maybe.map .play |> Maybe.map toMM |> Maybe.withDefault 0) - - fixedLoopWidth = - root.fixed |> Maybe.map .width |> Maybe.map toMM |> Maybe.withDefault 0 |> (*) widthModifier - - sectionWidth = - Basics.max freeLoopLength fixedLoopLength - - headerHeight = - 5.0 - - ( ox, oy ) = - topLeftFor anchor (Size sectionWidth (headerHeight + gap / 2 + freeLoopWidth + gap + fixedLoopWidth)) - in - g - [] - [ text_ - [ x (ox + sectionWidth / 2 |> String.fromFloat) - , y (oy + 4 |> String.fromFloat) - , fontSize "5" - , fontWeight "100" - , textAnchor "middle" - , fill "currentColor" - ] - [ text ("Loops / t = " ++ (toMM root.thickness |> String.fromFloat) ++ "mm") ] - , fixedLoop params (TopLeft ( ox, oy + headerHeight + gap / 2 )) - , freeLoop params (TopLeft ( ox, oy + headerHeight + gap * 1.5 + fixedLoopWidth )) - ] - - - fixedLoop : Parameters -> Anchor -> Svg msg - fixedLoop params anchor = - case params.shortPiece.loops.fixed of - Nothing -> - g [] [] - - Just { width, play } -> - let - strapThickness = - toMM params.thickness + toMM params.lining - - lugWidth = - toMM params.lugWidth - - length = - lugWidth * 2 + strapThickness * 2 + toMM play - - materialWidth = - case params.shortPiece.loops.style of - Simple -> - toMM width - - Folded -> - toMM width * 2 - - ( ox, oy ) = - topLeftFor anchor (Size length materialWidth) - - hCutLine : Float -> Svg msg - hCutLine yOffset = - g - [ fill "none" - , stroke "currentColor" - , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat) - ] - [ Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox, oy + yOffset ) - , HorizontalLineTo Relative lugWidth - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox + lugWidth, oy + yOffset ) - , HorizontalLineTo Relative strapThickness - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox + lugWidth + strapThickness, oy + yOffset ) - , HorizontalLineTo Relative lugWidth - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox + lugWidth * 2 + strapThickness, oy + yOffset ) - , HorizontalLineTo Relative strapThickness - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox + lugWidth * 2 + strapThickness * 2, oy + yOffset ) - , HorizontalLineTo Relative (toMM play) - ] - ] - [] - ] - in - g - [] - [ hCutLine 0 - , hCutLine materialWidth - , case params.shortPiece.loops.style of - Simple -> - g - [ fill "none" - , stroke "currentColor" - , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat) - ] - [ Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox, oy ) - , VerticalLineTo Relative (toMM width) - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox + length, oy ) - , VerticalLineTo Relative (toMM width) - ] - ] - [] - ] - - Folded -> - g - [] - [ g - [ fill "none" - , stroke "currentColor" - , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat) - , strokeDasharray "1 0.5" - ] - [ Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox, oy + toMM width / 2 ) - , HorizontalLineTo Relative length - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox, oy + toMM width * 1.5 ) - , HorizontalLineTo Relative length - ] - ] - [] - ] - , g - [ fill "none" - , stroke "currentColor" - , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat) - ] - [ Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox, oy ) - , VerticalLineTo Relative (toMM width * 2) - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox + length, oy ) - , VerticalLineTo Relative (toMM width * 2) - ] - ] - [] - ] - ] - ] - - - freeLoop : Parameters -> Anchor -> Svg msg - freeLoop params anchor = - case params.shortPiece.loops.free of - Nothing -> - g [] [] - - Just { 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 - - ( ox, oy ) = - topLeftFor anchor (Size length materialWidth) - - hCutLine : Float -> Svg msg - hCutLine yOffset = - g - [ fill "none" - , stroke "currentColor" - , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat) - ] - [ Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox, oy + yOffset ) - , HorizontalLineTo Relative lugWidth - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox + lugWidth, oy + yOffset ) - , HorizontalLineTo Relative strapThickness - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox + lugWidth + strapThickness, oy + yOffset ) - , HorizontalLineTo Relative lugWidth - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox + lugWidth * 2 + strapThickness, oy + yOffset ) - , HorizontalLineTo Relative strapThickness - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox + lugWidth * 2 + strapThickness * 2, oy + yOffset ) - , HorizontalLineTo Relative (toMM play) - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox + lugWidth * 2 + strapThickness * 2 + toMM play, oy + yOffset ) - , HorizontalLineTo Relative (toMM overlap) - ] - ] - [] - ] - in - g - [] - [ hCutLine 0 - , hCutLine materialWidth - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox + toMM overlap, oy ) - , 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 - [ Svg.Path.d - [ MoveTo Absolute ( ox, oy ) - , VerticalLineTo Relative (toMM width) - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox + length, oy ) - , VerticalLineTo Relative (toMM width) - ] - ] - [] - ] - - Folded -> - g - [] - [ g - [ fill "none" - , stroke "currentColor" - , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat) - , strokeDasharray "1 0.5" - ] - [ Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox, oy + toMM width / 2 ) - , HorizontalLineTo Relative length - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox, oy + toMM width * 1.5 ) - , HorizontalLineTo Relative length - ] - ] - [] - ] - , g - [ fill "none" - , stroke "currentColor" - , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat) - ] - [ Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox, oy ) - , VerticalLineTo Relative (toMM width * 2) - ] - ] - [] - , Svg.path - [ Svg.Path.d - [ MoveTo Absolute ( ox + length, oy ) - , VerticalLineTo Relative (toMM width * 2) - ] - ] - [] - ] - ] - ]
• src/Template/Cuts.elm (new)
  • @@ -0,0 +1,733 @@
    + -- 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, 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 + |> 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
• src/Template/InfoArea.elm (new)
  • @@ -0,0 +1,194 @@
    + -- 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.InfoArea exposing (infoArea) + + import Length exposing (toMM) + import Parameters exposing (Parameters) + import Svg exposing (..) + import Svg.Attributes as Attrs exposing (..) + import Svg.Path as Path exposing (..) + import Template.Layout.Container as Container exposing (aligned, columns, gapped, noGrow, padded, rows, withOutline) + import Template.Layout.Coordinate exposing (Request(..)) + import Template.Layout.Item exposing (Item) + + + infoArea : Parameters -> Item msg + infoArea params = + rows + |> Container.build + [ columns + |> gapped 10 + |> aligned Container.End + |> withOutline + { color = "currentColor" + , width = 0.2 + , radius = 0.3 + } + |> padded 3 + |> Container.build [ scaleChcker |> noGrow, legends params |> noGrow ] + ] + + + scaleChcker : Item msg + scaleChcker = + { size = { width = Exactly 10, height = Exactly 10 } + , element = + \p _ -> + let + x : Float -> String + x n = + String.fromFloat (p.x + n) + + y : Float -> String + y n = + String.fromFloat (p.y + n) + in + g + [] + [ g + [ stroke "currentColor", strokeWidth "0.2" ] + [ line + [ x1 (x 0), y1 (y 8), x2 (x 0), y2 (y 10) ] + [] + , line + [ x1 (x 0), y1 (y 9), x2 (x 10), y2 (y 9) ] + [] + , line + [ x1 (x 10), y1 (y 8), x2 (x 10), y2 (y 10) ] + [] + ] + , text_ + [ Attrs.x (x 5) + , Attrs.y (y 7) + , fontSize "3" + , fontWeight "100" + , textAnchor "middle" + , fill "currentColor" + ] + [ text "10mm" ] + ] + } + + + legends : Parameters -> Item msg + legends params = + rows + |> gapped 2 + |> aligned Container.Start + |> Container.build + [ columns + |> gapped 2 + |> aligned Container.Center + |> Container.build + [ Item + { width = Exactly 8, height = Exactly 5 } + (\p size -> + Svg.path + [ Path.d + [ MoveTo Absolute ( p.x, p.y + size.height / 2 ) + , HorizontalLineTo Relative size.width + ] + , stroke "currentColor" + , strokeWidth (params.rendering.lineWidth |> toMM |> String.fromFloat) + ] + [] + ) + , Item + { width = Exactly 12, height = Exactly 4 } + (\p size -> + text_ + [ x (String.fromFloat p.x) + , y (String.fromFloat p.y) + , fontSize (String.fromFloat size.height) + , fontWeight "100" + , textAnchor "left" + , dominantBaseline "hanging" + , fill "currentColor" + ] + [ text "Cut line" ] + ) + ] + , columns + |> gapped 2 + |> aligned Container.Center + |> Container.build + [ Item + { width = Exactly 8, height = Exactly 5 } + (\p size -> + rect + [ x (String.fromFloat p.x) + , y (String.fromFloat p.y) + , width (String.fromFloat size.width) + , height (String.fromFloat size.height) + , stroke "currentColor" + , strokeWidth "0.2" + , fill "url(#SkivingPattern)" + ] + [] + ) + , Item + { width = Exactly 21, height = Exactly 4 } + (\p size -> + text_ + [ x (String.fromFloat p.x) + , y (String.fromFloat p.y) + , fontSize (String.fromFloat size.height) + , fontWeight "100" + , textAnchor "left" + , dominantBaseline "hanging" + , fill "currentColor" + ] + [ text "Skiving area" ] + ) + ] + , columns + |> gapped 2 + |> aligned Container.Center + |> Container.build + [ Item + { width = Exactly 8, height = Exactly 5 } + (\p size -> + g + [ fill "none" + , stroke "currentColor" + , strokeWidth "0.1" + ] + [ Svg.path + [ Path.d + [ MoveTo Absolute ( p.x + (size.width - size.height) / 2, p.y + size.height / 2 ) + , HorizontalLineTo Relative size.height + ] + ] + [] + , Svg.path + [ Path.d + [ MoveTo Absolute ( p.x + size.width / 2, p.y ) + , VerticalLineTo Relative size.height + ] + ] + [] + ] + ) + , Item + { width = Exactly 12, height = Exactly 4 } + (\p size -> + text_ + [ x (String.fromFloat p.x) + , y (String.fromFloat p.y) + , fontSize (String.fromFloat size.height) + , fontWeight "100" + , textAnchor "left" + , dominantBaseline "hanging" + , fill "currentColor" + ] + [ text "Hole center" ] + ) + ] + ]
• src/Template/Layout.elm (new)
  • @@ -0,0 +1,36 @@
    + -- 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.Layout exposing (render) + + import Svg exposing (..) + import Template.Layout.Coordinate exposing (..) + import Template.Layout.Item exposing (Item) + + + render : Size -> Item msg -> Svg msg + render size item = + let + width = + case item.size.width of + Exactly w -> + min w size.width + + AtLeast _ -> + size.width + + height = + case item.size.height of + Exactly h -> + min h size.height + + AtLeast _ -> + size.height + in + item.element (Point2D 0 0) (Size width height)
• src/Template/Layout/Container.elm (new)
  • @@ -0,0 +1,437 @@
    + -- 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.Layout.Container exposing + ( Container + , ContainerChildAlignment(..) + , ContainerDirection(..) + , ContainerSizing(..) + , aligned + , build + , columns + , debugOutline + , gapped + , noGrow + , padded + , rows + , sized + , withContentOutline + , withElement + , withOutline + ) + + import Html.Attributes exposing (align) + import Svg exposing (..) + import Svg.Attributes as Attrs + import Template.Layout.Coordinate exposing (..) + import Template.Layout.Item exposing (Item) + + + isHorizontallyGrowable : Item msg -> Bool + isHorizontallyGrowable item = + case item.size.width of + AtLeast _ -> + True + + _ -> + False + + + isVerticallyGrowable : Item msg -> Bool + isVerticallyGrowable item = + case item.size.height of + AtLeast _ -> + True + + _ -> + False + + + type ContainerChildAlignment + = Stretch + | Start + | Center + | End + + + type ContainerSizing + = Intrinsic + | Sized (Request Float) (Request Float) + + + type alias ContainerRenderingContext = + { containerOrigin : Point2D + , containerSize : Size + , renderingAreaOrigin : Point2D + , renderingAreaSize : Size + } + + + type ContainerDirection + = Row + | Column + + + type alias Container msg = + { size : ContainerSizing + , gap : Float + , padding : Float + , align : ContainerChildAlignment + , elements : List (ContainerRenderingContext -> Svg msg) + , direction : ContainerDirection + } + + + rows : Container msg + rows = + { size = Intrinsic + , gap = 0 + , padding = 0 + , align = Stretch + , elements = [] + , direction = Row + } + + + columns : Container msg + columns = + { size = Intrinsic + , gap = 0 + , padding = 0 + , align = Stretch + , elements = [] + , direction = Column + } + + + sized : Request Float -> Request Float -> Container msg -> Container msg + sized width height props = + { props | size = Sized width height } + + + gapped : Float -> Container msg -> Container msg + gapped gap props = + { props | gap = gap } + + + padded : Float -> Container msg -> Container msg + padded padding props = + { props | padding = padding } + + + aligned : ContainerChildAlignment -> Container msg -> Container msg + aligned align props = + { props | align = align } + + + withElement : (ContainerRenderingContext -> Svg msg) -> Container msg -> Container msg + withElement f props = + { props | elements = f :: props.elements } + + + type alias Outline = + { color : String + , width : Float + , radius : Float + } + + + debugOutline : Outline + debugOutline = + { color = "#f00" + , width = 0.1 + , radius = 0.0 + } + + + withOutline : Outline -> Container msg -> Container msg + withOutline { color, width, radius } props = + { props + | elements = + (\ctx -> + g + [] + [ rect + [ Attrs.x (String.fromFloat ctx.containerOrigin.x) + , Attrs.y (String.fromFloat ctx.containerOrigin.y) + , Attrs.width (String.fromFloat ctx.containerSize.width) + , Attrs.height (String.fromFloat ctx.containerSize.height) + , Attrs.fill "none" + , Attrs.stroke color + , Attrs.strokeWidth (String.fromFloat width) + , Attrs.rx (String.fromFloat radius) + , Attrs.ry (String.fromFloat radius) + ] + [] + ] + ) + :: props.elements + } + + + withContentOutline : Outline -> Container msg -> Container msg + withContentOutline { color, width, radius } props = + { props + | elements = + (\ctx -> + g + [] + [ rect + [ Attrs.x (String.fromFloat ctx.renderingAreaOrigin.x) + , Attrs.y (String.fromFloat ctx.renderingAreaOrigin.y) + , Attrs.width (String.fromFloat ctx.renderingAreaSize.width) + , Attrs.height (String.fromFloat ctx.renderingAreaSize.height) + , Attrs.fill "none" + , Attrs.stroke color + , Attrs.strokeWidth (String.fromFloat width) + , Attrs.rx (String.fromFloat radius) + , Attrs.ry (String.fromFloat radius) + ] + [] + ] + ) + :: props.elements + } + + + noGrow : Item msg -> Item msg + noGrow item = + { item + | size = + { width = + case item.size.width of + AtLeast n -> + Exactly n + + Exactly n -> + Exactly n + , height = + case item.size.height of + AtLeast n -> + Exactly n + + Exactly n -> + Exactly n + } + } + + + build : List (Item msg) -> Container msg -> Item msg + build items { size, gap, padding, align, elements, direction } = + let + getCtx : Point2D -> Size -> ContainerRenderingContext + getCtx p s = + { containerOrigin = p + , containerSize = s + , renderingAreaOrigin = + { x = p.x + padding + , y = p.y + padding + } + , renderingAreaSize = + { width = s.width - padding * 2 + , height = s.height - padding * 2 + } + } + in + case items of + [] -> + { size = SizeRequest (Exactly 0) (Exactly 0) + , element = + \p s -> + let + ctx = + getCtx p s + in + g [] (List.map (\e -> e ctx) elements) + } + + _ -> + let + ( innerMinWidth, innerMinHeight ) = + case direction of + Row -> + ( items + |> List.map (\item -> minSizeOf item.size |> .width) + |> List.maximum + |> Maybe.withDefault 0.0 + , items + |> List.map (\item -> minSizeOf item.size |> .height) + |> List.intersperse gap + |> List.foldl (+) 0.0 + ) + + Column -> + ( items + |> List.map (\item -> minSizeOf item.size |> .width) + |> List.intersperse gap + |> List.foldl (+) 0.0 + , items + |> List.map (\item -> minSizeOf item.size |> .height) + |> List.maximum + |> Maybe.withDefault 0.0 + ) + in + { size = + case size of + Intrinsic -> + case direction of + Row -> + { width = AtLeast (innerMinWidth + padding * 2) + , height = Exactly (innerMinHeight + padding * 2) + } + + Column -> + { width = Exactly (innerMinWidth + padding * 2) + , height = AtLeast (innerMinHeight + padding * 2) + } + + Sized w h -> + { width = + case w of + Exactly v -> + Exactly v + + AtLeast v -> + AtLeast (max v (innerMinWidth + padding * 2)) + , height = + case h of + Exactly v -> + Exactly v + + AtLeast v -> + AtLeast (max v (innerMinHeight + padding * 2)) + } + , element = + \p s -> + let + ctx = + getCtx p s + + children = + case direction of + Row -> + let + freeHeight = + max 0 (ctx.renderingAreaSize.height - innerMinHeight) + + grow = + freeHeight / (items |> List.filter isVerticallyGrowable |> List.length |> toFloat) + in + items + |> List.foldl + (\item ( yOffset, els ) -> + let + height = + case item.size.height of + Exactly h -> + h + + AtLeast h -> + h + grow + + width = + case align of + Stretch -> + ctx.renderingAreaSize.width + + _ -> + case item.size.width of + Exactly w -> + min w ctx.renderingAreaSize.width + + AtLeast _ -> + ctx.renderingAreaSize.width + + ( y, yAdvance ) = + case els of + [] -> + ( yOffset, yOffset + height ) + + _ -> + ( yOffset + gap, yOffset + gap + height ) + + x = + case align of + Center -> + ctx.renderingAreaOrigin.x + (ctx.renderingAreaSize.width / 2 - width / 2) + + End -> + ctx.renderingAreaOrigin.x + (ctx.renderingAreaSize.width - width) + + _ -> + ctx.renderingAreaOrigin.x + in + ( yAdvance + , item.element (Point2D x y) (Size width height) :: els + ) + ) + ( ctx.renderingAreaOrigin.y, [] ) + |> Tuple.second + + Column -> + let + freeWidth = + max 0 (ctx.renderingAreaSize.width - innerMinWidth) + + grow = + freeWidth / (items |> List.filter isHorizontallyGrowable |> List.length |> toFloat) + in + items + |> List.foldl + (\item ( xOffset, els ) -> + let + width = + case item.size.width of + Exactly w -> + w + + AtLeast w -> + w + grow + + height = + case align of + Stretch -> + ctx.renderingAreaSize.height + + _ -> + case item.size.height of + Exactly h -> + min h ctx.renderingAreaSize.height + + AtLeast _ -> + ctx.renderingAreaSize.height + + ( x, xAdvance ) = + case els of + [] -> + ( xOffset, xOffset + width ) + + _ -> + ( xOffset + gap, xOffset + gap + width ) + + y = + case align of + Center -> + ctx.renderingAreaOrigin.y + (ctx.renderingAreaSize.height / 2 - height / 2) + + End -> + ctx.renderingAreaOrigin.y + (ctx.renderingAreaSize.height - height) + + _ -> + ctx.renderingAreaOrigin.y + in + ( xAdvance + , item.element (Point2D x y) (Size width height) :: els + ) + ) + ( ctx.renderingAreaOrigin.x, [] ) + |> Tuple.second + in + g [] (children ++ List.map (\e -> e ctx) elements) + }
• src/Template/Layout/Coordinate.elm (new)
  • @@ -0,0 +1,46 @@
    + -- 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.Layout.Coordinate exposing (..) + + + type alias Point2D = + { x : Float, y : Float } + + + type alias Size = + { width : Float, height : Float } + + + type Request a + = Exactly a + | AtLeast a + + + type alias SizeRequest = + { width : Request Float, height : Request Float } + + + minSizeOf : SizeRequest -> Size + minSizeOf s = + { width = + case s.width of + Exactly w -> + w + + AtLeast w -> + w + , height = + case s.height of + Exactly h -> + h + + AtLeast h -> + h + }
• src/Template/Layout/Item.elm (new)
  • @@ -0,0 +1,19 @@
    + -- 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.Layout.Item exposing (..) + + import Svg exposing (..) + import Template.Layout.Coordinate exposing (..) + + + type alias Item msg = + { size : SizeRequest + , element : Point2D -> Size -> Svg msg + }