Add QR code output option It's heavy, though.

Changes

8 changed files (+121/-30)

• elm.json
  • @@ -12,10 +12,18 @@
    "elm/json": "1.1.4", "elm/svg": "1.0.1", "elm/time": "1.0.0", - "elm/url": "1.0.0" + "elm/url": "1.0.0", + "pablohirafuji/elm-qrcode": "4.0.2" }, "indirect": { - "elm/virtual-dom": "1.0.5" + "avh4/elm-color": "1.0.0", + "danfishgold/base64-bytes": "1.1.0", + "elm/bytes": "1.0.8", + "elm/regex": "1.0.0", + "elm/virtual-dom": "1.0.5", + "elm-community/list-extra": "8.7.0", + "folkertdev/elm-flate": "2.0.5", + "justgook/elm-image": "5.0.0" } }, "test-dependencies": {
• src/Main.elm
  • @@ -159,7 +159,12 @@ view model =
    "print" ) ] - [ template model.parameters.parameters highlighting [] ] + [ template + model.url + model.parameters.parameters + highlighting + [] + ] , node "x-panel" [ slot "parameters" ] [ node "x-parameters"
• src/Parameters.elm
  • @@ -139,6 +139,7 @@ type alias Rendering =
    , gap : Length , lineWidth : Length , colorSchema : ColorSchema + , qrCode : Bool }
  • @@ -214,6 +215,7 @@ default =
    , gap = mm 10 , lineWidth = mm 0.3 , colorSchema = BlackOnWhite + , qrCode = False } }
  • @@ -289,6 +291,13 @@ toDict params =
    Nothing -> [] ) + |> (++) + (if params.rendering.qrCode then + [ ( Key.toString QRCode, "" ) ] + + else + [] + ) |> Dict.fromList
• src/Parameters/App.elm
  • @@ -829,5 +829,24 @@ view model =
    } ] } + , boolField model + { key = QRCode + , title = [ text "QR code" ] + , description = + [ text "Add QR code points to this page's URL to the output. " + , text "As the QR code generation is computationally heavy process, I recommend you to disable " + , text "this while editing parameters." + ] + , attrs = [] + , disabled = False + , true = + { label = [ text "Enabled" ] + , description = [ text "Output QR code." ] + } + , false = + { label = [ text "Disabled" ] + , description = [ text "Do not output QR code." ] + } + } ] ]
• src/Parameters/Key.elm
  • @@ -37,6 +37,7 @@ type Key
    | CanvasMargin | LineWidth | ColorSchema + | QRCode | Version
  • @@ -123,3 +124,6 @@ toString key =
    ColorSchema -> "color-schema" + + QRCode -> + "qrcode"
• src/Parameters/Parser.elm
  • @@ -373,22 +373,30 @@ parseLongPiece fields =
    ) - parseCanvas : ParametersDict -> Result Errors Parameters.Rendering - parseCanvas fields = + parseRendering : ParametersDict -> Result Errors Parameters.Rendering + parseRendering fields = case - ( parseField CanvasMargin (parseLength constraints.rendering.margin) fields - , parseField LineWidth (parseLength constraints.rendering.lineWidth) fields - , parseField ColorSchema parseColorSchema fields + ( ( parseField CanvasMargin (parseLength constraints.rendering.margin) fields + , parseField LineWidth (parseLength constraints.rendering.lineWidth) fields + , parseField ColorSchema parseColorSchema fields + ) + , hasKey QRCode fields ) of - ( Ok margin, Ok lineWidth, Ok colorSchema ) -> + ( ( Ok margin, Ok lineWidth, Ok colorSchema ), qrCode ) -> let base = Parameters.default.rendering in - Ok { base | margin = margin, lineWidth = lineWidth, colorSchema = colorSchema } - - ( margin, lineWidth, colorSchema ) -> + Ok + { base + | margin = margin + , lineWidth = lineWidth + , colorSchema = colorSchema + , qrCode = qrCode + } + + ( ( margin, lineWidth, colorSchema ), _ ) -> Err (mkErrors [ ( CanvasMargin, getError margin )
  • @@ -411,7 +419,7 @@ parse fields =
    , parseShortPiece fields , parseFieldWithDefault Taper (mm 0) (parseLength constraints.taper) fields ) - , parseCanvas fields + , parseRendering fields ) of ( ( Ok lugWidth, Ok lining, Ok thickness ), ( Ok longPiece, Ok shortPiece, Ok taper ), Ok rendering ) ->
• src/Template.elm
  • @@ -21,10 +21,11 @@ import Template.InfoArea exposing (infoArea)
    import Template.Layout as Layout import Template.Layout.Container as Container import Template.Layout.Coordinate exposing (Request(..)) + import Url exposing (Url) - template : Parameters -> Maybe Key -> List (Svg.Attribute msg) -> Svg.Svg msg - template params highlighting attrs = + template : Url -> Parameters -> Maybe Key -> List (Svg.Attribute msg) -> Svg.Svg msg + template url params highlighting attrs = let ( canvasWidth, canvasHeight ) = canvasSizeDimension params.rendering.size
  • @@ -68,7 +69,7 @@ template params highlighting attrs =
    |> Container.padded margin |> Container.build [ cuts params highlighting - , infoArea params + , infoArea url params ] |> Layout.render { width = canvasWidth, height = canvasHeight } ]
• src/Template/InfoArea.elm
  • @@ -11,32 +11,48 @@ module Template.InfoArea exposing (infoArea)
    import Length exposing (toMM) import Parameters exposing (Parameters) + import QRCode import Svg exposing (..) import Svg.Attributes as Attrs exposing (..) import Svg.Path as Path exposing (..) import Template.Layout.Container as Container exposing (aligned, columns, gapped, noGrow, padded, rows, withOutline) import Template.Layout.Coordinate exposing (Request(..)) import Template.Layout.Item exposing (Item) + import Url exposing (Url) - infoArea : Parameters -> Item msg - infoArea params = + infoArea : Url -> Parameters -> Item msg + infoArea url params = rows + |> withOutline + { color = "currentColor" + , width = 0.2 + , radius = 0.3 + } |> Container.build [ columns - |> gapped 5 - |> aligned Container.End - |> withOutline - { color = "currentColor" - , width = 0.2 - , radius = 0.3 - } - |> padded 2 |> Container.build - [ scaleChcker |> noGrow - , legends params |> noGrow - , legal - ] + ([ rows + |> Container.build + [ columns + |> gapped 5 + |> aligned Container.End + |> padded 2 + |> Container.build + [ scaleChcker |> noGrow + , legends params |> noGrow + , legal + ] + ] + |> Just + , if params.rendering.qrCode then + qrCode url + + else + Nothing + ] + |> List.filterMap identity + ) ]
  • @@ -233,3 +249,24 @@ legends params =
    ) ] ] + + + qrCode : Url -> Maybe (Item msg) + qrCode url = + QRCode.fromString (Url.toString url) + |> Result.toMaybe + |> Maybe.map + (\pixels -> + Item + { width = Exactly 50, height = Exactly 50 } + (\p size -> + QRCode.toSvg + [ width (String.fromFloat size.width) + , height (String.fromFloat size.height) + , x (String.fromFloat p.x) + , y (String.fromFloat p.y) + , stroke "currentColor" + ] + pixels + ) + )