Changes
6 changed files (+161/-29)
-
-
@@ -14,8 +14,19 @@ import Length exposing (Length, mm, toMM)import Parameters.Key as Key exposing (Key(..)) type TipShape type TipStyle = Round | Pointed Int tipStyleToString : TipStyle -> String tipStyleToString shape = case shape of Round -> "round" Pointed _ -> "pointed" type alias BuckleHole =
-
@@ -36,7 +47,7 @@ This does not have to be longer than `ShortPiece`.-} type alias LongPiece = { length : Length , tip : TipShape , tip : TipStyle , buckleHole : BuckleHole }
-
@@ -200,6 +211,7 @@toDict : Parameters -> ParametersDict toDict params = [ ( "version", "1.0" ) , ( Key.toString TipStyle, tipStyleToString params.longPiece.tip ) , ( Key.toString ShoulderWidth, String.fromFloat (toMM params.shoulderWidth) ) , ( Key.toString LongPieceLength, String.fromFloat (toMM params.longPiece.length) ) , ( Key.toString LoopStyle, loopStyleToString params.shortPiece.loops.style )
-
@@ -213,6 +225,14 @@ , ( Key.toString BuckleHoleInterval, String.fromFloat (toMM params.longPiece.buckleHole.interval) ), ( Key.toString BuckleHoleDiameter, String.fromFloat (toMM params.longPiece.buckleHole.diameter) ) , ( Key.toString Profile, profileKind params.profile ) ] |> (++) (case params.longPiece.tip of Round -> [] Pointed sharpness -> [ ( Key.toString TipSharpness, String.fromInt sharpness ) ] ) |> (++) (case params.profile of Straight ->
-
@@ -260,6 +280,7 @@ -}fallbackValues : ParametersDict fallbackValues = [ ( Key.toString TaperTo, "18" ) , ( Key.toString TipSharpness, "25" ) , ( Key.toString FixedLoopWidth, String.fromFloat (toMM defaultFixedLoop.width) ) , ( Key.toString FixedLoopLength, String.fromFloat (toMM defaultFixedLoop.length) ) , ( Key.toString FreeLoopWidth, String.fromFloat (toMM defaultFreeLoop.width) )
-
-
-
@@ -16,7 +16,7 @@ import Html.Attributes exposing (..)import Html.Events exposing (onBlur, onFocus, onInput) import Html.LivingStandard exposing (..) import Length exposing (Length, mm, toMM) import Parameters exposing (ColorSchema(..), LoopStyle(..), Parameters, ParametersDict, colorSchemaToString, getKey, hasKey, loopStyleToString, profileKind) import Parameters exposing (ColorSchema(..), LoopStyle(..), Parameters, ParametersDict, colorSchemaToString, getKey, hasKey, loopStyleToString, profileKind, tipStyleToString) import Parameters.Constraints exposing (NumberConstraints, constraints) import Parameters.Key as Key exposing (Key(..)) import Parameters.Parser exposing (..)
-
@@ -567,6 +567,31 @@ , description = [ text "Width of the tip and buckle-edge." ], unit = Just "mm" , disabled = model.parameters.profile == Parameters.Straight , attrs = step "1.0" :: lengthFieldAttrs constraints.taperTo } , choiceField model { key = TipStyle , title = [ text "Tip Style" ] , description = [ text "Shape of the long piece's end." ] , disabled = False , attrs = [] , choices = [ { label = [ text "Round" ] , description = [ text "Semicircle end. Popular in military watch straps." ] , value = tipStyleToString Parameters.Round } , { label = [ text "Pointed" ] , description = [ text "Steep curves forming a pointy edge. The most common shape regardless of strap style." ] , value = tipStyleToString (Parameters.Pointed 0) } ] } , numberField model { key = TipSharpness , title = [ text "Tip Sharpness" ] , description = [ text "Sharpness of the pointed tip. Lower the softer tip, and higher the sharper tip." ] , unit = Nothing , disabled = model.parameters.longPiece.tip == Parameters.Round , attrs = step "1" :: intFieldAttrs constraints.longPiece.tipSharpness } , numberField model { key = LongPieceLength
-
-
-
@@ -55,6 +55,7 @@type alias LongPiece = { buckleHole : BuckleHole , length : NumberConstraints Length , tipSharpness : NumberConstraints Int }
-
@@ -84,6 +85,7 @@ , interval = { min = Just (mm 1), max = Just (mm 10) }, distance = { min = Just (mm 1), max = Just (mm 130) } } , length = { min = Just (mm 5), max = Just (mm 150) } , tipSharpness = { min = Just 0, max = Just 100 } } , shortPiece = { loops =
-
-
-
@@ -12,6 +12,8 @@type Key = ShoulderWidth | TipStyle | TipSharpness | Profile | TaperTo | BuckleHoleDistance
-
@@ -40,6 +42,12 @@ toString key =case key of Version -> "version" TipStyle -> "tip-style" TipSharpness -> "tip-sharpness" Profile -> "profile"
-
-
-
@@ -294,22 +294,52 @@ ]) parseTipStyle : ParametersDict -> Result Errors Parameters.TipStyle parseTipStyle fields = case getKey TipStyle fields of Just "round" -> Ok Parameters.Round Just "pointed" -> case parseField TipSharpness (parseInt constraints.longPiece.tipSharpness) fields of Ok sharpness -> Ok (Parameters.Pointed sharpness) Err err -> mkErrors [ ( TipSharpness, Just err ) ] |> Err Just text -> mkErrors [ ( TipStyle, Just (NonexistentVariant text) ) ] |> Err Nothing -> mkErrors [ ( TipStyle, Just MissingValue ) ] |> Err parseLongPiece : ParametersDict -> Result Errors Parameters.LongPiece parseLongPiece fields = 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, length = length } case ( ( parseBuckleHole fields , parseField LongPieceLength (parseLength constraints.longPiece.length) fields ) , parseTipStyle fields ) of ( ( Ok buckleHole, Ok length ), Ok tip ) -> Ok { buckleHole = buckleHole, length = length, tip = tip } ( buckleHole, length ) -> Err (Dict.union (getError buckleHole |> Maybe.withDefault Dict.empty) (mkErrors [ ( LongPieceLength, getError length ) ]) ) ( ( buckleHole, length ), tip ) -> [ Just (mkErrors [ ( LongPieceLength, getError length ) ]) , getError buckleHole , getError tip ] |> List.filterMap identity |> List.map Dict.toList |> List.concat |> Dict.fromList |> Err parseRendering : ParametersDict -> Result Errors Parameters.Rendering
-
-
-
@@ -10,7 +10,7 @@module Template.Cuts exposing (cuts) import Length exposing (Length, toMM) import Parameters exposing (LoopStyle(..), Parameters, Profile(..)) import Parameters exposing (LoopStyle(..), Parameters, Profile(..), TipStyle(..)) import Parameters.Key exposing (Key(..)) import Svg exposing (..) import Svg.Attributes exposing (..)
-
@@ -112,6 +112,14 @@ shoulderWidth - toMM tobuckleWidth = shoulderWidth - taper curvedSectionLength = case params.longPiece.tip of Round -> buckleWidth / 2 Pointed _ -> buckleWidth in Svg.g []
-
@@ -119,18 +127,43 @@ [ Svg.path[ Path.d (MoveTo Absolute ( x, y ) :: LineTo Relative ( taper / 2, taperUntil ) :: VerticalLineTo Relative (length - buckleWidth / 2 - taperUntil) :: EllipticalArcCurve Relative { rx = buckleWidth / 2 , ry = buckleWidth / 2 , angle = 0.0 , largeArcFlag = LargeArc , sweepFlag = Counterclockwise , x = buckleWidth , y = 0 } [] :: VerticalLineTo Relative -(length - buckleWidth / 2 - taperUntil) :: VerticalLineTo Relative (length - curvedSectionLength - taperUntil) :: (case params.longPiece.tip of Round -> [ EllipticalArcCurve Relative { rx = buckleWidth / 2 , ry = buckleWidth / 2 , angle = 0.0 , largeArcFlag = LargeArc , sweepFlag = Counterclockwise , x = buckleWidth , y = 0 } [] ] Pointed sharpness -> let sy = buckleWidth * (toFloat (100 - sharpness) / 100) in [ CubicBezierCurve Relative ( ( 0, sy ) , ( buckleWidth / 2, buckleWidth ) , ( buckleWidth / 2, buckleWidth ) ) [] , CubicBezierCurve Relative ( ( 0, 0 ) , ( buckleWidth / 2, -(buckleWidth - sy) ) , ( buckleWidth / 2, -buckleWidth ) ) [] ] ) ++ VerticalLineTo Relative -(length - curvedSectionLength - taperUntil) :: LineTo Relative ( taper / 2, -taperUntil ) :: commands )
-
@@ -168,6 +201,19 @@ :: highlightStroke (highlighting == Just LongPieceLength):: guideStroke ) [] , case params.longPiece.tip of Round -> g [] [] Pointed _ -> Svg.path (Path.d [ MoveTo Absolute ( x + taper / 2, y + (length - curvedSectionLength) ) , HorizontalLineTo Relative buckleWidth ] :: guideStroke ) [] , case params.profile of Straight -> g [] []
-