Add input fields to remaining parameters Flaps are not included, as I'm yet to decide whether I should add "spring bar diameter" and change the flaps to "overlaps".

Changes

5 changed files (+186/-35)

• src/Parameters.elm
  • @@ -65,6 +65,16 @@ = Simple
    | Folded + loopStyleToString : LoopStyle -> String + loopStyleToString style = + case style of + Simple -> + "simple" + + Folded -> + "folded" + + type alias Loops = { fixed : Maybe FixedLoop , free : Maybe FreeLoop
  • @@ -165,7 +175,7 @@ { length = mm 80
    , loops = { fixed = Just defaultFixedLoop , free = Just defaultFreeLoop - , style = Folded + , style = Simple , thickness = mm 1.0 } , caseSideFlap = mm 15
• src/Parameters/App.elm
  • @@ -15,7 +15,7 @@ import Html.Attributes exposing (..)
    import Html.Events exposing (onInput) import Html.LivingStandard exposing (..) import Length exposing (Length, toMM) - import Parameters exposing (ColorSchema(..), Parameters, colorSchemaToString, defaultFixedLoop, defaultFreeLoop) + import Parameters exposing (ColorSchema(..), LoopStyle(..), Parameters, colorSchemaToString, defaultFixedLoop, defaultFreeLoop, loopStyleToString) import Parameters.Constraints exposing (NumberConstraints, constraints) import Parameters.Key as Key exposing (Key(..)) import Parameters.Parser exposing (..)
  • @@ -48,9 +48,13 @@ Dict.fromList
    [ ( Key.toString LugWidth, String.fromFloat (toMM params.lugWidth) ) , ( Key.toString SurfaceThickness, String.fromFloat (toMM params.thickness) ) , ( Key.toString LiningThickness, String.fromFloat (toMM params.lining) ) + , ( Key.toString BuckleHoleOffset, String.fromFloat (toMM params.longPiece.buckleHole.offset) ) , ( Key.toString BuckleHoleCount, String.fromInt params.longPiece.buckleHole.count ) + , ( Key.toString BuckleHoleInterval, String.fromFloat (toMM params.longPiece.buckleHole.interval) ) , ( Key.toString BuckleHoleDiameter, String.fromFloat (toMM params.longPiece.buckleHole.diameter) ) + , ( Key.toString LongPieceLength, String.fromFloat (toMM params.longPiece.length) ) , ( Key.toString LoopThickness, String.fromFloat (toMM params.shortPiece.loops.thickness) ) + , ( Key.toString LoopStyle, loopStyleToString params.shortPiece.loops.style ) , ( Key.toString HasFixedLoop , if params.shortPiece.loops.fixed == Nothing then "false"
  • @@ -80,6 +84,7 @@ )
    , ( Key.toString FreeLoopOverlap , params.shortPiece.loops.free |> Maybe.withDefault defaultFreeLoop |> .overlap |> toMM |> String.fromFloat ) + , ( Key.toString ShortPieceLength, String.fromFloat (toMM params.shortPiece.length) ) , ( Key.toString CanvasMargin, String.fromFloat (toMM params.rendering.margin) ) , ( Key.toString LineWidth, String.fromFloat (toMM params.rendering.lineWidth) ) , ( Key.toString ColorSchema, colorSchemaToString params.rendering.colorSchema )
  • @@ -186,71 +191,84 @@
    parseLoops : Fields -> Result Errors Parameters.Loops parseLoops fields = - case ( parseFixedLoop fields, parseFreeLoop fields ) of - ( Ok fixed, Ok free ) -> + case ( parseFixedLoop fields, parseFreeLoop fields, parseField LoopStyle parseLoopStyle fields ) of + ( Ok fixed, Ok free, Ok style ) -> let base = Parameters.default.shortPiece.loops in - Ok { base | fixed = fixed, free = free } + Ok { base | fixed = fixed, free = free, style = style } - ( fixed, free ) -> - Err - (Dict.union - (getError fixed |> Maybe.withDefault Dict.empty) - (getError free |> Maybe.withDefault Dict.empty) - ) + ( fixed, free, style ) -> + [ getError fixed |> Maybe.withDefault Dict.empty + , getError free |> Maybe.withDefault Dict.empty + , mkErrors [ ( LoopStyle, getError style ) ] + ] + |> List.map Dict.toList + |> List.concat + |> Dict.fromList + |> Err parseShortPiece : Fields -> Result Errors Parameters.ShortPiece parseShortPiece fields = - case parseLoops fields of - Ok loops -> + case ( parseLoops fields, parseField ShortPieceLength (parseLength constraints.shortPiece.length) fields ) of + ( Ok loops, Ok length ) -> let base = Parameters.default.shortPiece in - Ok { base | loops = loops } + Ok { base | loops = loops, length = length } - Err errs -> - Err errs + ( loops, length ) -> + Err + (Dict.union + (getError loops |> Maybe.withDefault Dict.empty) + (mkErrors [ ( ShortPieceLength, getError length ) ]) + ) parseBuckleHole : Fields -> Result Errors Parameters.BuckleHole parseBuckleHole fields = case - ( parseField BuckleHoleCount (parseInt constraints.longPiece.buckleHole.count) fields - , parseField BuckleHoleDiameter (parseLength constraints.longPiece.buckleHole.diameter) fields + ( ( parseField BuckleHoleCount (parseInt constraints.longPiece.buckleHole.count) fields + , parseField BuckleHoleDiameter (parseLength constraints.longPiece.buckleHole.diameter) fields + ) + , ( parseField BuckleHoleOffset (parseLength constraints.longPiece.buckleHole.offset) fields + , parseField BuckleHoleInterval (parseLength constraints.longPiece.buckleHole.interval) fields + ) ) of - ( Ok count, Ok diameter ) -> - let - base = - Parameters.default.longPiece.buckleHole - in - Ok { base | count = count, diameter = diameter } + ( ( Ok count, Ok diameter ), ( Ok offset, Ok interval ) ) -> + Ok { count = count, diameter = diameter, offset = offset, interval = interval } - ( count, diameter ) -> + ( ( count, diameter ), ( offset, interval ) ) -> Err (mkErrors [ ( BuckleHoleCount, getError count ) , ( BuckleHoleDiameter, getError diameter ) + , ( BuckleHoleOffset, getError offset ) + , ( BuckleHoleInterval, getError interval ) ] ) parseLongPiece : Fields -> Result Errors Parameters.LongPiece parseLongPiece fields = - case parseBuckleHole fields of - Ok buckleHole -> + case ( parseBuckleHole fields, parseField LongPieceLength (parseLength constraints.longPiece.length) fields ) of + ( Ok buckleHole, Ok length ) -> let base = Parameters.default.longPiece in - Ok { base | buckleHole = buckleHole } + Ok { base | buckleHole = buckleHole, length = length } - Err errors -> - Err errors + ( buckleHole, length ) -> + Err + (Dict.union + (getError buckleHole |> Maybe.withDefault Dict.empty) + (mkErrors [ ( LongPieceLength, getError length ) ]) + ) parseCanvas : Fields -> Result Errors Parameters.Rendering
  • @@ -514,6 +532,7 @@ { key : Key
    , title : List (Html.Html msg) , description : List (Html.Html msg) , attrs : List (Html.Attribute msg) + , disabled : Bool , choices : List { value : String
  • @@ -524,9 +543,14 @@ }
    choiceField : Model -> ChoiceFieldProps Msg -> Html.Html Msg - choiceField model { key, title, description, attrs, choices } = + choiceField model { key, title, disabled, description, attrs, choices } = node "x-field" - [] + [ if disabled then + attribute "disabled" "" + + else + class "" + ] (span [ slot "title" ] title :: p [ slot "description" ] description :: List.map
  • @@ -551,13 +575,14 @@ else
    class "" ] [ Html.label [ for id, slot "label" ] choice.label - , Html.p [ Html.Attributes.id choiceDescriptionId, slot "description" ] description + , Html.p [ Html.Attributes.id choiceDescriptionId, slot "description" ] choice.description , input (type_ "radio" :: Html.Attributes.id id :: Html.Attributes.name (Key.toString key) :: Html.Attributes.value choice.value :: Html.Attributes.checked checked + :: Html.Attributes.disabled disabled :: Html.Events.onCheck (\_ -> FieldChanged key choice.value) :: ariaDescribedBy [ choiceDescriptionId ] :: attrs
  • @@ -618,6 +643,26 @@ , unit = Just "mm"
    , disabled = False , attrs = step "0.1" :: lengthFieldAttrs constraints.lining } + , numberField model + { key = LongPieceLength + , title = [ text "Length (Tail Side)" ] + , description = + [ text "Length of the tail-side piece, which is usually the longer one." + ] + , unit = Just "mm" + , disabled = False + , attrs = step "1" :: lengthFieldAttrs constraints.longPiece.length + } + , numberField model + { key = ShortPieceLength + , title = [ text "Length (Buckle Side)" ] + , description = + [ text "Length of the buckle-side piece, which is usually the shorter one." + ] + , unit = Just "mm" + , disabled = False + , attrs = step "1" :: lengthFieldAttrs constraints.shortPiece.length + } ] , hr [] [] , group
  • @@ -631,6 +676,16 @@ , disabled = False
    , attrs = step "1" :: intFieldAttrs constraints.longPiece.buckleHole.count } , numberField model + { key = BuckleHoleOffset + , title = [ text "Hole Offset" ] + , description = + [ text "Distance between strap end (lug-side) and first buckle hole." ] + , unit = Just "mm" + , disabled = model.parameters.longPiece.buckleHole.count == 0 + , attrs = + step "1.0" :: lengthFieldAttrs constraints.longPiece.buckleHole.offset + } + , numberField model { key = BuckleHoleDiameter , title = [ text "Hole Diameter" ] , description =
  • @@ -640,15 +695,56 @@ , disabled = model.parameters.longPiece.buckleHole.count == 0
    , attrs = step "1.0" :: lengthFieldAttrs constraints.longPiece.buckleHole.diameter } + , numberField model + { key = BuckleHoleInterval + , title = [ text "Hole Interval" ] + , description = + [ text "Center-to-center interval between buckle holes." ] + , unit = Just "mm" + , disabled = model.parameters.longPiece.buckleHole.count == 0 + , attrs = + step "0.5" :: lengthFieldAttrs constraints.longPiece.buckleHole.interval + } ] , hr [] [] , group { title = [ text "Loops" ], description = Nothing } [ choiceField model + { key = LoopStyle + , title = [ text "Loop Style" ] + , description = [ text "Style of the fixed loop and the free loop." ] + , disabled = + not (Dict.get (Key.toString HasFixedLoop) model.fields == Just "true") + && not (Dict.get (Key.toString HasFreeLoop) model.fields == Just "true") + , attrs = [] + , choices = + [ { label = [ text "Simple" ] + , description = [ text "Simply use a strip of leather as a loop." ] + , value = loopStyleToString Simple + } + , { label = [ text "Folded" ] + , description = [ text "Fold a strip of leather to hide edges (fibers.)" ] + , value = loopStyleToString Folded + } + ] + } + , numberField model + { key = LoopThickness + , title = [ text "Loop Leather Thickness" ] + , description = [ text "Thickness of the leather to use for loops. Final thickness will be doubled if you choose \"Folded\" style." ] + , unit = Just "mm" + , disabled = + not (Dict.get (Key.toString HasFixedLoop) model.fields == Just "true") + && not (Dict.get (Key.toString HasFreeLoop) model.fields == Just "true") + , attrs = + step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.thickness + } + , choiceField model { key = HasFixedLoop , title = [ text "Fixed Loop" ] , description = [ text "Whether to draw fixed loop. Certain kind of deployant buckles don't require a fixed loop." ] , attrs = [] + , disabled = False , choices = [ { label = [ text "Enabled" ] , description = [ text "Output fixed loop." ]
  • @@ -683,6 +779,7 @@ { key = HasFreeLoop
    , title = [ text "Free Loop" ] , description = [ text "Whether to draw free loop. Certain kind of deployant buckles don't require a free loop." ] , attrs = [] + , disabled = False , choices = [ { label = [ text "Enabled" ] , description = [ text "Output free loop." ]
  • @@ -748,6 +845,7 @@ { key = ColorSchema
    , title = [ text "Color Schema" ] , description = [ text "Color schema of the template." ] , attrs = [] + , disabled = False , choices = [ { label = [ text "Black on White" ] , description = [ text "Select this if you print the template with a regular printer." ]
• src/Parameters/Constraints.elm
  • @@ -35,22 +35,27 @@
    type alias Loops = { fixed : FixedLoop , free : FreeLoop + , thickness : NumberConstraints Length } type alias ShortPiece = { loops : Loops + , length : NumberConstraints Length } type alias BuckleHole = { count : NumberConstraints Int , diameter : NumberConstraints Length + , interval : NumberConstraints Length + , offset : NumberConstraints Length } type alias LongPiece = { buckleHole : BuckleHole + , length : NumberConstraints Length }
  • @@ -77,7 +82,10 @@ , longPiece =
    { buckleHole = { count = { min = Just 0, max = Just 10 } , diameter = { min = Just (mm 1), max = Just (mm 10) } + , interval = { min = Just (mm 1), max = Just (mm 10) } + , offset = { min = Just (mm 1), max = Just (mm 100) } } + , length = { min = Just (mm 5), max = Just (mm 150) } } , shortPiece = { loops =
  • @@ -90,7 +98,9 @@ { width = { min = Just (mm 1), max = Just (mm 15) }
    , play = { min = Just (mm 0), max = Just (mm 10) } , overlap = { min = Just (mm 0), max = Just (mm 10) } } + , thickness = { min = Just (mm 0.1), max = Just (mm 1) } } + , length = { min = Just (mm 5), max = Just (mm 150) } } , lining = { min = Just (mm 0), max = Just (mm 5) } , thickness = { min = Just (mm 0.1), max = Just (mm 5) }
• src/Parameters/Key.elm
  • @@ -14,9 +14,13 @@ type Key
    = LugWidth | SurfaceThickness | LiningThickness + | BuckleHoleOffset | BuckleHoleCount + | BuckleHoleInterval | BuckleHoleDiameter + | LongPieceLength | LoopThickness + | LoopStyle | HasFixedLoop | FixedLoopWidth | FixedLoopPlay
  • @@ -24,6 +28,7 @@ | HasFreeLoop
    | FreeLoopWidth | FreeLoopPlay | FreeLoopOverlap + | ShortPieceLength | CanvasMargin | LineWidth | ColorSchema
  • @@ -41,14 +46,26 @@
    LiningThickness -> "lining-thickness" + BuckleHoleOffset -> + "buckle-hole-offset" + BuckleHoleCount -> "buckle-hole-count" BuckleHoleDiameter -> "buckle-hole-diameter" + BuckleHoleInterval -> + "buckle-hole-interval" + + LongPieceLength -> + "long-piece-length" + LoopThickness -> "loop-thickness" + + LoopStyle -> + "loop-style" HasFixedLoop -> "has-fixed-loop"
  • @@ -70,6 +87,9 @@ "free-loop-play"
    FreeLoopOverlap -> "free-loop-overlap" + + ShortPieceLength -> + "short-piece-length" CanvasMargin -> "canvas-margin"
• src/Parameters/Parser.elm
  • @@ -7,10 +7,10 @@ --
    -- SPDX-License-Identifier: MPL-2.0 - module Parameters.Parser exposing (Error(..), parseBool, parseColorSchema, parseInt, parseLength) + module Parameters.Parser exposing (Error(..), parseBool, parseColorSchema, parseInt, parseLength, parseLoopStyle) import Length exposing (Length, mm, toMM) - import Parameters exposing (ColorSchema(..)) + import Parameters exposing (ColorSchema(..), LoopStyle(..)) import Parameters.Constraints as Constraints
  • @@ -139,3 +139,16 @@ Ok BlackOnWhite
    _ -> Err (NonexistentVariant text) + + + parseLoopStyle : String -> Result Error LoopStyle + parseLoopStyle text = + case text of + "simple" -> + Ok Simple + + "folded" -> + Ok Folded + + _ -> + Err (NonexistentVariant text)