Add highlighting feature Sometimes I myself wonder "how does this field's value affect the generated template?"

Changes

7 changed files (+212/-54)

• src/Main.elm
  • @@ -17,7 +17,7 @@ import Html.LivingStandard exposing (..)
    import Json.Decode import Parameters import Parameters.App - import Preferences + import Preferences exposing (FieldHighlight(..)) import Preferences.App import Template exposing (template) import Url exposing (Url)
  • @@ -115,6 +115,15 @@ update msg model =
    view : Model -> Browser.Document Msg view model = + let + highlighting = + case model.preferences.preferences.fieldHighlight of + HighlightOnPreview -> + model.parameters.highlighting + + DoNotHighlight -> + Nothing + in { title = "" , body = [ node "x-app-layout"
  • @@ -138,7 +147,7 @@ view model =
    "print" ) ] - [ template model.parameters.parameters [] ] + [ template model.parameters.parameters highlighting [] ] , node "x-panel" [ slot "parameters" ] [ node "x-parameters"
• src/Parameters/App.elm
  • @@ -12,13 +12,14 @@ module Parameters.App exposing (Model, Msg, init, update, view)
    import Dict exposing (Dict) import Html exposing (hr, input, label, node, p, span, text) import Html.Attributes exposing (..) - import Html.Events exposing (onInput) + import Html.Events exposing (onBlur, onFocus, onInput) import Html.LivingStandard exposing (..) import Length exposing (Length, toMM) 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 (..) + import Platform.Cmd as Cmd
  • @@ -37,6 +38,7 @@ type alias Model =
    { fields : Fields , errors : Errors , parameters : Parameters + , highlighting : Maybe Key }
  • @@ -99,6 +101,7 @@ init params =
    Err errors -> errors , parameters = params + , highlighting = Nothing }
  • @@ -109,6 +112,8 @@ init params =
    type Msg = FieldChanged Key String | ColorSchemaChanged ColorSchema + | Highlight Key + | Unhighlight Key parseField : Key -> (String -> Result Error a) -> Fields -> Result Error a
  • @@ -373,6 +378,16 @@ update msg model =
    , Cmd.none ) + Highlight key -> + ( { model | highlighting = Just key }, Cmd.none ) + + Unhighlight key -> + if model.highlighting == Just key then + ( { model | highlighting = Nothing }, Cmd.none ) + + else + ( model, Cmd.none ) + -- VIEW
  • @@ -507,6 +522,8 @@ numberField model { key, title, description, attrs, unit, disabled } =
    (id (Key.toString key) :: value (model.fields |> Dict.get (Key.toString key) |> Maybe.withDefault "") :: onInput (FieldChanged key) + :: onFocus (Highlight key) + :: onBlur (Unhighlight key) :: ariaInvalid (not (Dict.get (Key.toString key) model.errors == Nothing)) :: ariaDescribedBy [ errorId key, descriptionId key ] :: Html.Attributes.disabled disabled
• src/Preferences.elm
  • @@ -7,7 +7,7 @@
    -- SPDX-License-Identifier: MPL-2.0 - module Preferences exposing (Preferences, PreviewTheme(..), decoder, defaultPreferences, encode) + module Preferences exposing (FieldHighlight(..), Preferences, PreviewTheme(..), decoder, defaultPreferences, encode) import Json.Decode as Decode import Json.Encode as Encode
  • @@ -47,29 +47,70 @@ encodePreviewTheme theme =
    ) + type FieldHighlight + = HighlightOnPreview + | DoNotHighlight + + + fieldHighlightDecoder : Decode.Decoder FieldHighlight + fieldHighlightDecoder = + Decode.string + |> Decode.andThen + (\str -> + case str of + "highlight_on_preview" -> + Decode.succeed HighlightOnPreview + + "do_not_highlight" -> + Decode.succeed DoNotHighlight + + _ -> + Decode.fail ("\"" ++ str ++ "\" is not a valid FieldHighlight value") + ) + + + encodeFieldHighlight : FieldHighlight -> Decode.Value + encodeFieldHighlight status = + Encode.string + (case status of + HighlightOnPreview -> + "highlight_on_preview" + + DoNotHighlight -> + "do_not_highlight" + ) + + {-| User preferences. This is not supposed to be shared. -} type alias Preferences = { previewTheme : PreviewTheme + , fieldHighlight : FieldHighlight } defaultPreferences : Preferences defaultPreferences = { previewTheme = SystemTheme + , fieldHighlight = DoNotHighlight } decoder : Decode.Decoder Preferences decoder = - Decode.map + Decode.map2 Preferences (Decode.field "preview_theme" (Decode.oneOf [ previewThemeDecoder, Decode.succeed defaultPreferences.previewTheme ]) ) + (Decode.field "field_highlight" + (Decode.oneOf [ fieldHighlightDecoder, Decode.succeed defaultPreferences.fieldHighlight ]) + ) encode : Preferences -> Encode.Value encode p = Encode.object - [ ( "preview_theme", encodePreviewTheme p.previewTheme ) ] + [ ( "preview_theme", encodePreviewTheme p.previewTheme ) + , ( "field_highlight", encodeFieldHighlight p.fieldHighlight ) + ]
• src/Preferences/App.elm
  • @@ -15,7 +15,7 @@ import Html.Events
    import Html.LivingStandard exposing (..) import Json.Decode as Decode import Json.Encode as Encode - import Preferences exposing (Preferences, PreviewTheme(..)) + import Preferences exposing (FieldHighlight(..), Preferences, PreviewTheme(..))
  • @@ -52,6 +52,8 @@ init saved =
    type Msg = NoOp | SetPreviewTheme PreviewTheme + | SetFieldHighlight FieldHighlight + | WritePreferences update : Msg -> Model -> ( Model, Cmd Msg )
  • @@ -65,13 +67,13 @@ update msg model =
    ( model, Cmd.none ) SetPreviewTheme theme -> - let - nextPreferences = - { preferences | previewTheme = theme } - in - ( { model | preferences = { preferences | previewTheme = theme } } - , writePreferences (Preferences.encode nextPreferences) - ) + update WritePreferences { model | preferences = { preferences | previewTheme = theme } } + + SetFieldHighlight highlight -> + update WritePreferences { model | preferences = { preferences | fieldHighlight = highlight } } + + WritePreferences -> + ( model, writePreferences (Preferences.encode model.preferences) )
  • @@ -83,6 +85,11 @@ previewThemeId =
    "preview-theme" + fieldHighlightId : String + fieldHighlightId = + "field-highlight" + + descriptionId : String -> String descriptionId prefix = prefix ++ "_description"
  • @@ -160,5 +167,33 @@ panelItems model =
    } [] ] + , node "x-field" + [] + [ span [ slot "title" ] [ text "Field Highlight" ] + , p + [ slot "description" + , id (descriptionId fieldHighlightId) + ] + [ text "This does not affect print output." ] + , radioBox + { label = [ text "Enabled" ] + , description = + [ text "Highlight lines on preview relevant to the focused field." ] + , name = fieldHighlightId + , value = "highlight-on-preview" + , checked = model.preferences.fieldHighlight == HighlightOnPreview + , onCheck = SetFieldHighlight HighlightOnPreview + } + [] + , radioBox + { label = [ text "Disabled" ] + , description = [ text "Do not highlight on field focus." ] + , name = fieldHighlightId + , value = "do-not-highlight" + , checked = model.preferences.fieldHighlight == DoNotHighlight + , onCheck = SetFieldHighlight DoNotHighlight + } + [] + ] ] ]
• src/Template.elm
  • @@ -11,6 +11,7 @@ module Template exposing (template)
    import Length exposing (toMM) import Parameters exposing (LoopStyle(..), Parameters, canvasSizeDimension) + import Parameters.Key exposing (Key) import String import Svg exposing (..) import Svg.Attributes exposing (..)
  • @@ -22,8 +23,8 @@ import Template.Layout.Container as Container
    import Template.Layout.Coordinate exposing (Request(..)) - template : Parameters -> List (Svg.Attribute msg) -> Svg.Svg msg - template params attrs = + template : Parameters -> Maybe Key -> List (Svg.Attribute msg) -> Svg.Svg msg + template params highlighting attrs = let ( canvasWidth, canvasHeight ) = canvasSizeDimension params.rendering.size
  • @@ -66,7 +67,7 @@ template params attrs =
    |> Container.aligned Container.Center |> Container.padded margin |> Container.build - [ cuts params + [ cuts params highlighting , infoArea params ] |> Layout.render { width = canvasWidth, height = canvasHeight }
• src/Template/Cuts.elm
  • @@ -11,6 +11,7 @@ module Template.Cuts exposing (cuts)
    import Length exposing (Length, toMM) import Parameters exposing (LoopStyle(..), Parameters) + import Parameters.Key exposing (Key(..)) import Svg exposing (..) import Svg.Attributes exposing (..) import Svg.Path as Path exposing (..)
  • @@ -19,8 +20,17 @@ import Template.Layout.Coordinate exposing (Request(..))
    import Template.Layout.Item exposing (Item) - cuts : Parameters -> Item msg - cuts params = + highlightStroke : Bool -> Svg.Attribute msg + highlightStroke enabled = + if enabled then + class "highlight-stroke" + + else + class "highlight-none" + + + cuts : Parameters -> Maybe Key -> Item msg + cuts params highlighting = -- TODO: Pack items more smartly, so it won't push infoArea out rows |> sized (AtLeast 0) (AtLeast 0)
  • @@ -31,21 +41,21 @@ cuts params =
    ([ columns |> gapped (toMM params.rendering.gap) |> Container.build - ([ surfacePieces params - , linings params + ([ surfacePieces params highlighting + , linings params highlighting ] |> List.map noGrow ) |> Just - , loops params + , loops params highlighting ] |> List.filterMap identity |> List.map noGrow ) - surfacePieces : Parameters -> Item msg - surfacePieces params = + surfacePieces : Parameters -> Maybe Key -> Item msg + surfacePieces params highlighting = rows |> aligned Container.Center |> gapped (toMM params.rendering.gap / 2)
  • @@ -67,7 +77,7 @@ surfacePieces params =
    , columns |> gapped (toMM params.rendering.gap) |> Container.build - [ longPiece params, shortPiece params ] + [ longPiece params highlighting, shortPiece params highlighting ] ]
  • @@ -80,8 +90,8 @@ skivingSeamStroke params =
    ] - longPiece : Parameters -> Item msg - longPiece params = + longPiece : Parameters -> Maybe Key -> Item msg + longPiece params highlighting = let lugWidth = toMM params.lugWidth
  • @@ -117,6 +127,7 @@ longPiece params =
    , fill "none" , stroke "currentColor" , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat) + , highlightStroke (highlighting == Just LongPieceLength || highlighting == Just LugWidth) ] [] :: Svg.path
  • @@ -157,14 +168,25 @@ longPiece params =
    ( p.x + lugWidth / 2 , p.y + offset + interval * toFloat index ) + [ highlightStroke + (highlighting + == Just BuckleHoleDiameter + || highlighting + == Just BuckleHoleCount + || highlighting + == Just BuckleHoleInterval + || highlighting + == Just BuckleHoleOffset + ) + ] ) ) ) } - hole : Parameters -> Length -> ( Float, Float ) -> Svg msg - hole params diameter ( cx, cy ) = + hole : Parameters -> Length -> ( Float, Float ) -> List (Svg.Attribute msg) -> Svg msg + hole params diameter ( cx, cy ) attrs = let radius = toMM diameter / 2
  • @@ -172,13 +194,14 @@ hole params diameter ( cx, cy ) =
    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) - ] + (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) + :: attrs + ) [] , g [ fill "none"
  • @@ -203,8 +226,8 @@ hole params diameter ( cx, cy ) =
    ] - shortPiece : Parameters -> Item msg - shortPiece params = + shortPiece : Parameters -> Maybe Key -> Item msg + shortPiece params highlighting = let lugWidth = toMM params.lugWidth
  • @@ -235,6 +258,7 @@ shortPiece params =
    , fill "none" , stroke "currentColor" , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat) + , highlightStroke (highlighting == Just ShortPieceLength || highlighting == Just LugWidth) ] [] , g
  • @@ -281,8 +305,8 @@ shortPiece params =
    } - linings : Parameters -> Item msg - linings params = + linings : Parameters -> Maybe Key -> Item msg + linings params highlighting = rows |> aligned Container.Center |> gapped (toMM params.rendering.gap / 2)
  • @@ -304,12 +328,12 @@ linings params =
    , columns |> gapped (toMM params.rendering.gap) |> Container.build - [ longLining params, shortLining params ] + [ longLining params highlighting, shortLining params highlighting ] ] - longLining : Parameters -> Item msg - longLining params = + longLining : Parameters -> Maybe Key -> Item msg + longLining params highlighting = let lugWidth = toMM params.lugWidth
  • @@ -341,13 +365,14 @@ longLining params =
    , fill "none" , stroke "currentColor" , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat) + , highlightStroke (highlighting == Just LugWidth || highlighting == Just LongPieceLength) ] [] } - shortLining : Parameters -> Item msg - shortLining params = + shortLining : Parameters -> Maybe Key -> Item msg + shortLining params highlighting = let lugWidth = toMM params.lugWidth
  • @@ -370,13 +395,14 @@ shortLining params =
    , fill "none" , stroke "currentColor" , strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat) + , highlightStroke (highlighting == Just LugWidth || highlighting == Just ShortPieceLength) ] [] } - loops : Parameters -> Maybe (Item msg) - loops params = + loops : Parameters -> Maybe Key -> Maybe (Item msg) + loops params highlighting = let root = params.shortPiece.loops
  • @@ -407,8 +433,8 @@ loops params =
    , columns |> gapped (toMM params.rendering.gap) |> Container.build - ([ fixedLoop params - , freeLoop params + ([ fixedLoop params highlighting + , freeLoop params highlighting ] |> List.filterMap identity )
  • @@ -416,8 +442,8 @@ loops params =
    |> Just - fixedLoop : Parameters -> Maybe (Item msg) - fixedLoop params = + fixedLoop : Parameters -> Maybe Key -> Maybe (Item msg) + fixedLoop params highlighting = Maybe.map (\{ width, play } -> let
  • @@ -457,6 +483,7 @@ fixedLoop params =
    [ MoveTo Absolute ( p.x, p.y + yOffset ) , HorizontalLineTo Relative lugWidth ] + , highlightStroke (highlighting == Just LugWidth) ] [] , Svg.path
  • @@ -464,6 +491,7 @@ fixedLoop params =
    [ MoveTo Absolute ( p.x + lugWidth, p.y + yOffset ) , HorizontalLineTo Relative strapThickness ] + , highlightStroke (highlighting == Just SurfaceThickness || highlighting == Just LiningThickness) ] [] , Svg.path
  • @@ -471,6 +499,7 @@ fixedLoop params =
    [ MoveTo Absolute ( p.x + lugWidth + strapThickness, p.y + yOffset ) , HorizontalLineTo Relative lugWidth ] + , highlightStroke (highlighting == Just LugWidth) ] [] , Svg.path
  • @@ -478,6 +507,7 @@ fixedLoop params =
    [ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness, p.y + yOffset ) , HorizontalLineTo Relative strapThickness ] + , highlightStroke (highlighting == Just SurfaceThickness || highlighting == Just LiningThickness) ] [] , Svg.path
  • @@ -485,6 +515,7 @@ fixedLoop params =
    [ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness * 2, p.y + yOffset ) , HorizontalLineTo Relative (toMM play) ] + , highlightStroke (highlighting == Just FixedLoopPlay) ] [] ]
  • @@ -505,6 +536,7 @@ fixedLoop params =
    [ MoveTo Absolute ( p.x, p.y ) , VerticalLineTo Relative (toMM width) ] + , highlightStroke (highlighting == Just FixedLoopWidth) ] [] , Svg.path
  • @@ -512,6 +544,7 @@ fixedLoop params =
    [ MoveTo Absolute ( p.x + length, p.y ) , VerticalLineTo Relative (toMM width) ] + , highlightStroke (highlighting == Just FixedLoopWidth) ] [] ]
  • @@ -550,6 +583,7 @@ fixedLoop params =
    [ MoveTo Absolute ( p.x, p.y ) , VerticalLineTo Relative (toMM width * 2) ] + , highlightStroke (highlighting == Just FixedLoopWidth) ] [] , Svg.path
  • @@ -557,6 +591,7 @@ fixedLoop params =
    [ MoveTo Absolute ( p.x + length, p.y ) , VerticalLineTo Relative (toMM width * 2) ] + , highlightStroke (highlighting == Just FixedLoopWidth) ] [] ]
  • @@ -567,8 +602,8 @@ fixedLoop params =
    params.shortPiece.loops.fixed - freeLoop : Parameters -> Maybe (Item msg) - freeLoop params = + freeLoop : Parameters -> Maybe Key -> Maybe (Item msg) + freeLoop params highlighting = Maybe.map (\{ width, play, overlap } -> let
  • @@ -606,6 +641,7 @@ freeLoop params =
    [ MoveTo Absolute ( p.x, p.y + yOffset ) , HorizontalLineTo Relative lugWidth ] + , highlightStroke (highlighting == Just LugWidth) ] [] , Svg.path
  • @@ -613,6 +649,7 @@ freeLoop params =
    [ MoveTo Absolute ( p.x + lugWidth, p.y + yOffset ) , HorizontalLineTo Relative strapThickness ] + , highlightStroke (highlighting == Just SurfaceThickness || highlighting == Just LiningThickness) ] [] , Svg.path
  • @@ -620,6 +657,7 @@ freeLoop params =
    [ MoveTo Absolute ( p.x + lugWidth + strapThickness, p.y + yOffset ) , HorizontalLineTo Relative lugWidth ] + , highlightStroke (highlighting == Just LugWidth) ] [] , Svg.path
  • @@ -627,6 +665,7 @@ freeLoop params =
    [ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness, p.y + yOffset ) , HorizontalLineTo Relative strapThickness ] + , highlightStroke (highlighting == Just SurfaceThickness || highlighting == Just LiningThickness) ] [] , Svg.path
  • @@ -634,6 +673,7 @@ freeLoop params =
    [ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness * 2, p.y + yOffset ) , HorizontalLineTo Relative (toMM play) ] + , highlightStroke (highlighting == Just FreeLoopPlay) ] [] , Svg.path
  • @@ -641,6 +681,7 @@ freeLoop params =
    [ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness * 2 + toMM play, p.y + yOffset ) , HorizontalLineTo Relative (toMM overlap) ] + , highlightStroke (highlighting == Just FreeLoopOverlap) ] [] ]
  • @@ -651,7 +692,7 @@ freeLoop params =
    , hCutLine materialWidth , Svg.path [ Path.d - [ MoveTo Absolute ( p.x + toMM overlap, p.y ) + [ MoveTo Absolute ( p.x + length - toMM overlap, p.y ) , VerticalLineTo Relative materialWidth ] , fill "none"
  • @@ -672,6 +713,7 @@ freeLoop params =
    [ MoveTo Absolute ( p.x, p.y ) , VerticalLineTo Relative (toMM width) ] + , highlightStroke (highlighting == Just FreeLoopWidth) ] [] , Svg.path
  • @@ -679,6 +721,7 @@ freeLoop params =
    [ MoveTo Absolute ( p.x + length, p.y ) , VerticalLineTo Relative (toMM width) ] + , highlightStroke (highlighting == Just FreeLoopWidth) ] [] ]
  • @@ -717,6 +760,7 @@ freeLoop params =
    [ MoveTo Absolute ( p.x, p.y ) , VerticalLineTo Relative (toMM width * 2) ] + , highlightStroke (highlighting == Just FreeLoopWidth) ] [] , Svg.path
  • @@ -724,6 +768,7 @@ freeLoop params =
    [ MoveTo Absolute ( p.x + length, p.y ) , VerticalLineTo Relative (toMM width * 2) ] + , highlightStroke (highlighting == Just FreeLoopWidth) ] [] ]
• src/index.html
  • @@ -50,6 +50,10 @@ SPDX-License-Identifier: MPL-2.0
    margin: 0; } + :root { + --_highlight-color: oklch(50% 0.4 0deg); + } + @font-face { font-family: "Barlow"; font-weight: normal;
  • @@ -80,6 +84,12 @@ SPDX-License-Identifier: MPL-2.0
    margin: 0; } } + + @media not print { + x-preview > svg .highlight-stroke { + stroke: var(--_highlight-color); + } + } </style> </head> </html>