Add print margin parameter

Changes

5 changed files (+107/-34)

• src/Parameters.elm
  • @@ -82,6 +82,12 @@ A4 ->
    ( mm 210, mm 297 ) + type alias Canvas = + { size : CanvasSize + , margin : Length + } + + type alias Parameters = { lugWidth : Length , longPiece : LongPiece
  • @@ -89,7 +95,7 @@ , shortPiece : ShortPiece
    , profile : Profile , thickness : Length , lining : Maybe Length - , canvasSize : CanvasSize + , canvas : Canvas }
  • @@ -126,5 +132,8 @@ }
    , profile = Straight , thickness = mm 2.5 , lining = Just (mm 0.5) - , canvasSize = A4 + , canvas = + { size = A4 + , margin = mm 10 + } }
• src/Parameters/Constraints.elm
  • @@ -30,9 +30,15 @@ { buckleHole : BuckleHole
    } + type alias Canvas = + { margin : NumberConstraints Length + } + + type alias Parameters = { lugWidth : NumberConstraints Length , longPiece : LongPiece + , canvas : Canvas }
  • @@ -44,5 +50,8 @@ { buckleHole =
    { count = { min = Just 0, max = Just 10 } , diameter = { min = Just (mm 1), max = Just (mm 10) } } + } + , canvas = + { margin = { min = Just (mm 0), max = Just (mm 20) } } }
• src/Parameters/Form.elm
  • @@ -47,6 +47,7 @@ Dict.fromList
    [ ( Key.toString LugWidth, String.fromFloat (toMM params.lugWidth) ) , ( Key.toString BuckleHoleCount, String.fromInt params.longPiece.buckleHole.count ) , ( Key.toString BuckleHoleDiameter, String.fromFloat (toMM params.longPiece.buckleHole.diameter) ) + , ( Key.toString CanvasMargin, String.fromFloat (toMM params.canvas.margin) ) ] in { fields = fields
  • @@ -134,22 +135,44 @@ Err errors ->
    Err errors + parseCanvas : Fields -> Result Errors Parameters.Canvas + parseCanvas fields = + case parseField CanvasMargin (parseLength constraints.canvas.margin) fields of + Ok margin -> + let + base = + Parameters.default.canvas + in + Ok { base | margin = margin } + + Err err -> + Err (mkErrors [ ( CanvasMargin, Just err ) ]) + + parse : Fields -> Result Errors Parameters parse fields = case ( parseField LugWidth (parseLength constraints.lugWidth) fields , parseLongPiece fields + , parseCanvas fields ) of - ( Ok lugWidth, Ok longPiece ) -> + ( Ok lugWidth, Ok longPiece, Ok canvas ) -> let base = Parameters.default in - Ok { base | lugWidth = lugWidth, longPiece = longPiece } + Ok { base | lugWidth = lugWidth, longPiece = longPiece, canvas = canvas } - ( lugWidth, longPiece ) -> - Err (Dict.union (mkErrors [ ( LugWidth, getError lugWidth ) ]) (Maybe.withDefault Dict.empty (getError longPiece))) + ( lugWidth, longPiece, canvas ) -> + [ mkErrors [ ( LugWidth, getError lugWidth ) ] + , getError longPiece |> Maybe.withDefault Dict.empty + , getError canvas |> Maybe.withDefault Dict.empty + ] + |> List.map Dict.toList + |> List.concat + |> Dict.fromList + |> Err update : Msg -> Model -> ( Model, Cmd Msg )
  • @@ -361,6 +384,33 @@ ]
    , p [ id (errorId BuckleHoleDiameter), attribute "slot" "error" ] (Dict.get (Key.toString BuckleHoleDiameter) model.errors + |> Maybe.map errorText + |> Maybe.withDefault [] + ) + ] + , node "x-field" + [] + [ label [ for (Key.toString CanvasMargin), attribute "slot" "title" ] [ text "Print Margin" ] + , p + [ id (descriptionId CanvasMargin), attribute "slot" "description" ] + [ text "Lower values can cause printing problems depending on your printer." ] + , node "x-number-input" + [] + [ input + (id (Key.toString CanvasMargin) + :: step "1.0" + :: value CanvasMargin + :: onInput (FieldChanged CanvasMargin) + :: ariaInvalid (not (Dict.get (Key.toString CanvasMargin) model.errors == Nothing)) + :: ariaDescribedBy [ errorId CanvasMargin, descriptionId CanvasMargin ] + :: lengthFieldAttrs constraints.canvas.margin + ) + [] + , span [ attribute "slot" "unit" ] [ text "mm" ] + ] + , p + [ id (errorId CanvasMargin), attribute "slot" "error" ] + (Dict.get (Key.toString CanvasMargin) model.errors |> Maybe.map errorText |> Maybe.withDefault [] )
• src/Parameters/Key.elm
  • @@ -14,6 +14,7 @@ type Key
    = LugWidth | BuckleHoleCount | BuckleHoleDiameter + | CanvasMargin toString : Key -> String
  • @@ -27,3 +28,6 @@ "buckle-hole-count"
    BuckleHoleDiameter -> "buckle-hole-diameter" + + CanvasMargin -> + "canvas-margin"
• src/Template.elm
  • @@ -18,13 +18,13 @@ import Svg.Path exposing (LargeArcFlag(..), PathCommand(..), PointMode(..), SweepFlag(..))
    type Anchor - = TopLeft ( Int, Int ) - | TopRight ( Int, Int ) - | BottomLeft ( Int, Int ) - | BottomRight ( Int, Int ) + = TopLeft ( Float, Float ) + | TopRight ( Float, Float ) + | BottomLeft ( Float, Float ) + | BottomRight ( Float, Float ) - topLeftFor : Anchor -> ( Int, Int ) -> ( Int, Int ) + topLeftFor : Anchor -> ( Float, Float ) -> ( Float, Float ) topLeftFor anchor ( width, height ) = case anchor of TopLeft ( x, y ) ->
  • @@ -44,17 +44,18 @@ template : Parameters -> List (Svg.Attribute msg) -> Svg.Svg msg
    template params attrs = let ( canvasWidth, canvasHeight ) = - canvasSizeDimension params.canvasSize + canvasSizeDimension params.canvas.size |> Tuple.mapBoth toMM toMM - |> Tuple.mapBoth ceiling ceiling + + margin = + toMM params.canvas.margin in svg - (viewBox (String.join " " [ "0", "0", String.fromInt canvasWidth, String.fromInt canvasHeight ]) + (viewBox (String.join " " [ "0", "0", String.fromInt (ceiling canvasWidth), String.fromInt (ceiling canvasHeight) ]) :: class "print" :: attrs ) - -- TODO: Make margin configurable - [ scaleChecker (BottomLeft ( 10, canvasHeight - 10 )) + [ scaleChecker (BottomLeft ( margin, canvasHeight - margin )) , defs [] [ pattern
  • @@ -78,8 +79,8 @@ ]
    [] ] ] - , longPiece params (TopLeft ( 10, 10 )) - , shortPiece params (TopLeft ( ceiling (toMM params.lugWidth) + 20, 10 )) + , longPiece params (TopLeft ( margin, margin )) + , shortPiece params (TopLeft ( toMM params.lugWidth + margin + 10, margin )) ]
  • @@ -89,13 +90,13 @@ let
    ( ox, oy ) = topLeftFor anchor ( 10, 10 ) - px : Int -> String + px : Float -> String px n = - String.fromInt (ox + n) + String.fromFloat (ox + n) - py : Int -> String + py : Float -> String py n = - String.fromInt (oy + n) + String.fromFloat (oy + n) in g []
  • @@ -141,13 +142,13 @@ flap =
    toMM params.longPiece.flap ( ox, oy ) = - topLeftFor anchor ( ceiling lugWidth, ceiling length ) + topLeftFor anchor ( lugWidth, length ) in g [] (Svg.path [ Svg.Path.d - [ MoveTo Absolute ( toFloat ox, toFloat oy ) + [ MoveTo Absolute ( ox, oy ) , VerticalLineTo Relative (length + flap - lugWidth) , EllipticalArcCurve Relative { rx = lugWidth / 2
  • @@ -169,7 +170,7 @@ ]
    [] :: Svg.path (Svg.Path.d - [ MoveTo Absolute ( toFloat ox, toFloat oy + flap ) + [ MoveTo Absolute ( ox, oy + flap ) , HorizontalLineTo Relative lugWidth ] :: skivingSeamStroke
  • @@ -177,7 +178,7 @@ )
    [] :: Svg.path [ Svg.Path.d - [ MoveTo Absolute ( toFloat ox, toFloat oy ) + [ MoveTo Absolute ( ox, oy ) , HorizontalLineTo Relative lugWidth , VerticalLineTo Relative flap , HorizontalLineTo Relative -lugWidth
  • @@ -201,8 +202,8 @@ toMM buckleHole.interval
    in hole buckleHole.diameter - ( toFloat ox + lugWidth / 2 - , toFloat oy + offset + interval * toFloat index + ( ox + lugWidth / 2 + , oy + offset + interval * toFloat index ) ) )
  • @@ -265,13 +266,13 @@ claspSideFlap =
    toMM params.shortPiece.claspSideFlap ( ox, oy ) = - topLeftFor anchor ( ceiling lugWidth, ceiling length ) + topLeftFor anchor ( lugWidth, length ) in g [] [ Svg.path [ Svg.Path.d - [ MoveTo Absolute ( toFloat ox, toFloat oy ) + [ MoveTo Absolute ( ox, oy ) , VerticalLineTo Relative (length + caseSideFlap + claspSideFlap) , HorizontalLineTo Relative lugWidth , VerticalLineTo Relative -(length + caseSideFlap + claspSideFlap)
  • @@ -286,14 +287,14 @@ , g
    skivingSeamStroke [ Svg.path [ Svg.Path.d - [ MoveTo Absolute ( toFloat ox, toFloat oy + caseSideFlap ) + [ MoveTo Absolute ( ox, oy + caseSideFlap ) , HorizontalLineTo Relative lugWidth ] ] [] , Svg.path [ Svg.Path.d - [ MoveTo Absolute ( toFloat ox, toFloat oy + caseSideFlap + length ) + [ MoveTo Absolute ( ox, oy + caseSideFlap + length ) , HorizontalLineTo Relative lugWidth ] ]
  • @@ -303,7 +304,7 @@ , g
    [ fill "url(#SkivingPattern)" ] [ Svg.path [ Svg.Path.d - [ MoveTo Absolute ( toFloat ox, toFloat oy ) + [ MoveTo Absolute ( ox, oy ) , HorizontalLineTo Relative lugWidth , VerticalLineTo Relative caseSideFlap , HorizontalLineTo Relative -lugWidth
  • @@ -313,7 +314,7 @@ ]
    [] , Svg.path [ Svg.Path.d - [ MoveTo Absolute ( toFloat ox, toFloat oy + caseSideFlap + length ) + [ MoveTo Absolute ( ox, oy + caseSideFlap + length ) , HorizontalLineTo Relative lugWidth , VerticalLineTo Relative claspSideFlap , HorizontalLineTo Relative -lugWidth