Specify tapered width instead of taper amount Specifying taper amount is super unintuitive, even with the "xx/yy" notation.

Changes

6 changed files (+117/-53)

• src/Parameters.elm
  • @@ -135,13 +135,28 @@ type alias Rendering =
    } + type Profile + = Straight + | Tapered Length + + + profileKind : Profile -> String + profileKind profile = + case profile of + Straight -> + "straight" + + Tapered _ -> + "tapered" + + type alias Parameters = { lugWidth : Length , longPiece : LongPiece , shortPiece : ShortPiece , thickness : Length , lining : Length - , taper : Length + , profile : Profile , rendering : Rendering }
  • @@ -190,7 +205,7 @@ default =
    } , thickness = mm 2.5 , lining = mm 0.5 - , taper = mm 0 + , profile = Straight , rendering = { size = A4 , margin = mm 3
  • @@ -223,13 +238,15 @@ toDict params =
    , ( Key.toString BuckleHoleCount, String.fromInt params.longPiece.buckleHole.count ) , ( Key.toString BuckleHoleOffset, String.fromFloat (toMM params.longPiece.buckleHole.offset) ) , ( Key.toString BuckleHoleInterval, String.fromFloat (toMM params.longPiece.buckleHole.interval) ) + , ( Key.toString Profile, profileKind params.profile ) ] |> (++) - (if toMM params.taper > 0 then - [ ( Key.toString Taper, String.fromFloat (toMM params.taper) ) ] + (case params.profile of + Straight -> + [] - else - [] + Tapered to -> + [ ( Key.toString TaperTo, String.fromFloat (toMM to) ) ] ) |> (++) (if params.longPiece.buckleHole.count > 0 then
  • @@ -277,7 +294,7 @@ toDict params =
    -} fallbackValues : ParametersDict fallbackValues = - [ ( Key.toString Taper, "0" ) + [ ( Key.toString TaperTo, "18" ) , ( Key.toString FixedLoopWidth, String.fromFloat (toMM defaultFixedLoop.width) ) , ( Key.toString FixedLoopPlay, String.fromFloat (toMM defaultFixedLoop.play) ) , ( Key.toString FreeLoopWidth, String.fromFloat (toMM defaultFreeLoop.width) )
• src/Parameters/App.elm
  • @@ -15,8 +15,8 @@ import Html exposing (hr, input, label, node, p, span, text)
    import Html.Attributes exposing (..) import Html.Events exposing (onBlur, onFocus, onInput) import Html.LivingStandard exposing (..) - import Length exposing (Length, toMM) - import Parameters exposing (ColorSchema(..), LoopStyle(..), Parameters, ParametersDict, colorSchemaToString, getKey, hasKey, loopStyleToString) + import Length exposing (Length, mm, toMM) + import Parameters exposing (ColorSchema(..), LoopStyle(..), Parameters, ParametersDict, colorSchemaToString, getKey, hasKey, loopStyleToString, profileKind) import Parameters.Constraints exposing (NumberConstraints, constraints) import Parameters.Key as Key exposing (Key(..)) import Parameters.Parser exposing (..)
  • @@ -537,21 +537,30 @@ view model =
    , disabled = False , attrs = step "1.0" :: lengthFieldAttrs constraints.lugWidth } - , numberField model - { key = Taper - , title = [ text "Taper" ] - , description = - [ text "Taper size. " - , text (String.fromFloat (toMM model.parameters.taper)) - , text "mm taper makes the strap " - , text (String.fromFloat (toMM model.parameters.lugWidth)) - , text "/" - , text (String.fromFloat (toMM model.parameters.lugWidth - toMM model.parameters.taper)) - , text "mm." + , choiceField model + { key = Profile + , title = [ text "Profile" ] + , description = [ text "Shape of the straps." ] + , disabled = False + , attrs = [] + , choices = + [ { label = [ text "Straight" ] + , description = [ text "Lug width, tip width and buckle-edge width shares the same size." ] + , value = profileKind Parameters.Straight + } + , { label = [ text "Tapered" ] + , description = [ text "Narrows down to the specified width." ] + , value = profileKind (Parameters.Tapered (mm 0)) + } ] + } + , numberField model + { key = TaperTo + , title = [ text "Taper To" ] + , description = [ text "Width of the tip and buckle-edge." ] , unit = Just "mm" - , disabled = False - , attrs = step "1" :: lengthFieldAttrs constraints.taper + , disabled = model.parameters.profile == Parameters.Straight + , attrs = step "1.0" :: lengthFieldAttrs constraints.taperTo } , numberField model { key = SurfaceThickness
• src/Parameters/Constraints.elm
  • @@ -83,7 +83,7 @@ type alias Parameters =
    , shortPiece : ShortPiece , lining : NumberConstraints Length , thickness : NumberConstraints Length - , taper : NumberConstraints Length + , taperTo : NumberConstraints Length , rendering : Rendering }
  • @@ -120,7 +120,7 @@ constraints =
    } , lining = { min = Just (mm 0.1), max = Just (mm 5) } , thickness = { min = Just (mm 0.1), max = Just (mm 5) } - , taper = { min = Just (mm 0), max = Just (mm 8) } + , taperTo = { min = Just (mm 5), max = Just (mm 28) } , rendering = { margin = { min = Just (mm 0), max = Just (mm 20) } , lineWidth = { min = Just (mm 0.1), max = Just (mm 1) }
• src/Parameters/Key.elm
  • @@ -12,7 +12,8 @@ module Parameters.Key exposing (Key(..), toString)
    type Key = LugWidth - | Taper + | Profile + | TaperTo | SurfaceThickness | LiningThickness | BuckleHoleOffset
  • @@ -44,8 +45,11 @@ toString key =
    Version -> "version" - Taper -> - "taper" + Profile -> + "profile" + + TaperTo -> + "taper-to" LugWidth -> "lug-width"
• src/Parameters/Parser.elm
  • @@ -172,13 +172,6 @@ parseField key f fields =
    |> f - parseFieldWithDefault : Key -> a -> (String -> Result Error a) -> ParametersDict -> Result Error a - parseFieldWithDefault key default f fields = - getKey key fields - |> Maybe.map f - |> Maybe.withDefault (Ok default) - - parseFixedLoop : ParametersDict -> Result Errors (Maybe Parameters.FixedLoop) parseFixedLoop fields = if hasKey HasFixedLoop fields then
  • @@ -375,6 +368,24 @@ parseRendering fields =
    ) + parseProfile : ParametersDict -> Result Errors Parameters.Profile + parseProfile fields = + case getKey Profile fields of + Just "straight" -> + Ok Parameters.Straight + + Just "tapered" -> + case parseField TaperTo (parseLength constraints.taperTo) fields of + Ok taperTo -> + Ok (Parameters.Tapered taperTo) + + Err err -> + Err (mkErrors [ ( TaperTo, Just err ) ]) + + profile -> + Err (mkErrors [ ( Profile, Just (NonexistentVariant (Maybe.withDefault "" profile)) ) ]) + + parse : ParametersDict -> Result Errors Parameters parse fields = case getKey Version fields of
  • @@ -386,12 +397,12 @@ parse fields =
    ) , ( parseLongPiece fields , parseShortPiece fields - , parseFieldWithDefault Taper (mm 0) (parseLength constraints.taper) fields + , parseProfile fields ) , parseRendering fields ) of - ( ( Ok lugWidth, Ok lining, Ok thickness ), ( Ok longPiece, Ok shortPiece, Ok taper ), Ok rendering ) -> + ( ( Ok lugWidth, Ok lining, Ok thickness ), ( Ok longPiece, Ok shortPiece, Ok profile ), Ok rendering ) -> Ok { lugWidth = lugWidth , lining = lining
  • @@ -399,19 +410,19 @@ parse fields =
    , longPiece = longPiece , shortPiece = shortPiece , rendering = rendering - , taper = taper + , profile = profile } - ( ( lugWidth, lining, thickness ), ( longPiece, shortPiece, taper ), rendering ) -> + ( ( lugWidth, lining, thickness ), ( longPiece, shortPiece, profile ), rendering ) -> [ mkErrors [ ( LugWidth, getError lugWidth ) , ( LiningThickness, getError lining ) , ( SurfaceThickness, getError thickness ) - , ( Taper, getError taper ) ] , getError longPiece |> Maybe.withDefault Dict.empty , getError shortPiece |> Maybe.withDefault Dict.empty , getError rendering |> Maybe.withDefault Dict.empty + , getError profile |> Maybe.withDefault Dict.empty ] |> List.map Dict.toList |> List.concat
• src/Template/Cuts.elm
  • @@ -10,7 +10,7 @@
    module Template.Cuts exposing (cuts) import Length exposing (Length, toMM) - import Parameters exposing (LoopStyle(..), Parameters) + import Parameters exposing (LoopStyle(..), Parameters, Profile(..)) import Parameters.Key exposing (Key(..)) import Svg exposing (..) import Svg.Attributes exposing (..)
  • @@ -105,7 +105,12 @@ longPieceShape ( x, y ) params highlighting commands =
    (length / 2) taper = - toMM params.taper + case params.profile of + Straight -> + 0.0 + + Tapered to -> + lugWidth - toMM to buckleWidth = lugWidth - taper
  • @@ -146,14 +151,18 @@ longPieceShape ( x, y ) params highlighting commands =
    || highlighting == Just LugWidth || highlighting - == Just Taper - || (toMM params.taper - > 0 - && (highlighting + == Just Profile + || highlighting + == Just TaperTo + || (case params.profile of + Straight -> + False + + Tapered _ -> + highlighting == Just BuckleHoleOffset || highlighting == Just BuckleHoleInterval - ) ) ) ]
  • @@ -304,7 +313,12 @@ shortPieceShape params highlighting { includeCaseSideFlap, includeClaspSideFlap,
    (length / 2) taper = - toMM params.taper + case params.profile of + Straight -> + 0.0 + + Tapered to -> + lugWidth - toMM to ( x, y ) = at
  • @@ -362,14 +376,18 @@ shortPieceShape params highlighting { includeCaseSideFlap, includeClaspSideFlap,
    || highlighting == Just LugWidth || highlighting - == Just Taper - || (toMM params.taper - > 0 - && (highlighting + == Just Profile + || highlighting + == Just TaperTo + || (case params.profile of + Straight -> + False + + Tapered _ -> + highlighting == Just BuckleHoleOffset || highlighting == Just BuckleHoleInterval - ) ) ) ]
  • @@ -383,7 +401,12 @@ shortPiece params highlighting =
    toMM params.lugWidth taper = - toMM params.taper + case params.profile of + Straight -> + 0.0 + + Tapered to -> + lugWidth - toMM to buckleWidth = lugWidth - taper