diff --git a/elm.json b/elm.json index 1bbfcf8..00aa83e 100644 --- a/elm.json +++ b/elm.json @@ -9,7 +9,8 @@ "Collage.Render", "Collage.Events", "Collage.Layout", - "Collage.Text" + "Collage.Text", + "Collage.Sketchy" ], "elm-version": "0.19.0 <= v < 0.20.0", "dependencies": { diff --git a/examples/Axis.elm b/examples/Axis.elm index b35ec6a..0c7a664 100644 --- a/examples/Axis.elm +++ b/examples/Axis.elm @@ -1,14 +1,22 @@ module Axis exposing (main) +import Example import Collage exposing (..) -import Collage.Render exposing (..) import Collage.Text exposing (Text, fromString) import Color exposing (..) import Html exposing (Html) -main : Html msg +main : Platform.Program () (Example.Model () (Collage ())) (Example.Msg ()) main = + Example.example + { init = collage + , update = (\_ _ -> collage) + , render = (\_ -> collage) + , view = identity + } + +collage = let up = triangle 10 @@ -43,4 +51,3 @@ main = , box , ellipse 20 40 |> filled (uniform red) |> shift ( 50, 50 ) ] - |> svg diff --git a/examples/Composition.elm b/examples/Composition.elm index 5f06456..38914d4 100644 --- a/examples/Composition.elm +++ b/examples/Composition.elm @@ -1,14 +1,11 @@ module Composition exposing (main) -import Browser import Collage exposing (..) import Collage.Events exposing (onClick) import Collage.Layout exposing (..) -import Collage.Render exposing (svg) import Collage.Text exposing (fromString) import Color exposing (..) -import Html exposing (Html) - +import Example -- Model ----------------------------------------------------------------------- @@ -18,22 +15,19 @@ type alias Model = { active : Bool } -init : Model -init = { active = False } - - -- Update ---------------------------------------------------------------------- type Msg - = Switch + = Switch update : Msg -> Model -> Model update msg model = case msg of - Switch -> { model | active = not model.active } + Switch -> + { model | active = not model.active } @@ -59,12 +53,12 @@ txt = -- Shapes -- -elps : Model -> Collage Msg -elps model = +elps : Bool -> Collage Msg +elps active = ellipse 100 50 |> styled ( uniform <| - if model.active then + if active then lightPurple else lightBlue @@ -105,9 +99,7 @@ alignments = -- Main ------------------------------------------------------------------------ - -view : Model -> Html Msg -view model = +render model = vertical [ horizontal [ rect @@ -118,11 +110,15 @@ view model = |> center , debug penta ] - , stack [ showEnvelope txt, elps model ] + , stack [ showEnvelope txt, elps model.active ] ] - |> debug - |> svg -main : Program () Model Msg -main = Browser.sandbox { init = init, view = view, update = update } +main : Platform.Program () (Example.Model Msg Model) (Example.Msg Msg) +main = + Example.example + { init = Model False + , update = update + , render = render + , view = identity + } diff --git a/examples/Dimensions.elm b/examples/Dimensions.elm index 82f393b..adfec85 100644 --- a/examples/Dimensions.elm +++ b/examples/Dimensions.elm @@ -1,8 +1,8 @@ module Dimensions exposing (diamond, main) +import Example import Collage exposing (..) import Collage.Layout exposing (..) -import Collage.Render exposing (..) import Collage.Text as Text exposing (Shape(..), Text, fromString) import Color exposing (Color) import Html exposing (Html) @@ -42,11 +42,20 @@ diamond label = ] -main : Html msg -main = +collage = vertical [ diamond "a very long piece of text" , gap , diamond "short text" ] - |> svg + + +main : Platform.Program () (Example.Model () (Collage ())) (Example.Msg ()) +main = + Example.example + { init = collage + , update = (\_ _ -> collage) + , render = (\_ -> collage) + , view = identity + } + diff --git a/examples/Embedding.elm b/examples/Embedding.elm index 6cdc884..841224a 100644 --- a/examples/Embedding.elm +++ b/examples/Embedding.elm @@ -14,7 +14,7 @@ main = [ Html.button [] [ text "Hello Html!" ] ] - |> html ( 100, 100 ) + |> html ( 100, 100 ) [] , rectangle 100 100 |> filled (uniform Color.lightGreen) ] diff --git a/examples/Example.elm b/examples/Example.elm new file mode 100644 index 0000000..a9f0785 --- /dev/null +++ b/examples/Example.elm @@ -0,0 +1,103 @@ +module Example exposing (Model, Msg, example) + +import Browser +import Collage exposing (..) +import Collage.Render exposing (svg) +import Collage.Sketchy as Sketchy exposing (sketchy) +import Html exposing (Html) +import Html.Attributes +import Html.Events + + +type alias Config msg model = + { init : model + , update : msg -> model -> model + , render : model -> Collage msg + , view : Html msg -> Html msg + } + + +type Msg childMsg + = ClickedNormal + | ClickedSketchy + | ChildMsg childMsg + + +type Renderer + = Normal + | Sketchy + + +type alias Model childMsg childModel = + { collage : Collage childMsg + , renderer : Renderer + , model : childModel + , sketchyConfig : Sketchy.Config + } + + +init : (childModel -> Collage childMsg) -> childModel -> ( Model childMsg childModel, Cmd (Msg childMsg) ) +init render child = + let + model = + Model (render child) Normal child Sketchy.defaultConfig + in + ( model, Cmd.none ) + + +update : Config childMsg childModel -> Msg childMsg -> Model childMsg childModel -> ( Model childMsg childModel, Cmd (Msg childMsg) ) +update config msg model = + let + render m = + case m.renderer of + Sketchy -> + ( { m | collage = sketchy m.sketchyConfig (config.render m.model) } + , Cmd.none + ) + + Normal -> + ( { m | collage = config.render m.model } + , Cmd.none + ) + in + case msg of + ClickedNormal -> + { model | renderer = Normal } + |> render + + ClickedSketchy -> + { model | renderer = Sketchy, sketchyConfig = Sketchy.nextSeed model.sketchyConfig } + |> render + + ChildMsg cMsg -> + { model | model = config.update cMsg model.model } + |> render + + +example : Config childMsg childModel -> Platform.Program flags (Model childMsg childModel) (Msg childMsg) +example config = + Browser.element + { init = \_ -> init config.render config.init + , update = update config + , subscriptions = \_ -> Sub.none + , view = view config.view + } + + +button : String -> Msg childMsg -> Html (Msg childMsg) +button name msg = + Html.button [ Html.Events.onClick msg ] [ Html.text name ] + + +view : (Html childMsg -> Html childMsg) -> Model childMsg childModel -> Html (Msg childMsg) +view childView model = + Html.div [] + [ Html.div [ Html.Attributes.style "margin-bottom" "10px" ] + [ button "Normal" ClickedNormal + , button "Sketchy" ClickedSketchy + ] + , model.collage + |> svg + |> childView + |> Html.map ChildMsg + ] diff --git a/examples/Flowchart.elm b/examples/Flowchart.elm index fbf16d4..5df6eb5 100644 --- a/examples/Flowchart.elm +++ b/examples/Flowchart.elm @@ -1,11 +1,12 @@ module Flowchart exposing (main) +import Example import Collage exposing (..) -import Collage.Layout exposing (..) -import Collage.Render exposing (..) -import Collage.Text as Text exposing (Shape(..), fromString) +import Collage.Layout as Layout exposing (..) +import Collage.Text as Text exposing (Shape(..), fromString, Typeface(..)) import Color exposing (..) import Html exposing (Html) +import Html.Attributes import List exposing (head) @@ -14,129 +15,159 @@ import List exposing (head) type Flow - = Finish - | Task String - | Sequence Flow Flow - | Choice String Flow Flow - | Parallel (List Flow) + = Finish + | Task String + | Sequence Flow Flow + | Choice String Flow Flow + | Parallel (List Flow) example : Flow example = - Sequence - (Sequence (Task "check diff") - (Choice "diff is as whished" - (Sequence - (Parallel - [ Task "prepare changelog" - , Task "bump version" - ] - ) - (Task "publish") + Sequence + (Sequence (Task "check diff") + (Choice "diff is as wished" + (Sequence + (Parallel + [ Task "prepare changelog" + , Task "bump version" + ] + ) + (Task "publish") + ) + (Task "work harder") + ) ) - (Task "work harder") - ) - ) - Finish + Finish -- Elements -------------------------------------------------------------------- +fontFamily : String +fontFamily = + "Caveat" + + +font : Typeface +font = + Font fontFamily + + unit : Float -unit = 30 +unit = + 50 space : Collage msg -space = spacer unit unit +space = + spacer unit unit thinline : LineStyle thinline = - { defaultLineStyle - | thickness = thin - , cap = Padded - } + { defaultLineStyle + | thickness = verythin + , cap = Padded + } thickline : LineStyle thickline = - { defaultLineStyle - | thickness = ultrathick - , cap = Padded - } + { defaultLineStyle + | thickness = semithick + , cap = Padded + } diamond : String -> Collage msg diamond label = - let - text = - fromString label - |> Text.shape Italic - |> rendered - w = width text - l = unit / 2 - points = - [ ( 0, l ) - , ( -l, 0 ) - , ( 0, -l ) - , ( w, -l ) - , ( w + l, 0 ) - , ( w, l ) - ] - shape = - polygon points - |> styled - ( uniform lightPurple - , thinline - ) - |> center - in - impose text shape + let + text = + fromString label + |> Text.shape Italic + |> Text.size Text.huge + |> Text.weight Text.Black + |> Text.typeface font + |> rendered + + w = + width text + + l = + unit / 2 + + points = + [ ( 0, l ) + , ( -l, 0 ) + , ( 0, -l ) + , ( w, -l ) + , ( w + l, 0 ) + , ( w, l ) + ] + + shape = + polygon points + |> styled + ( uniform lightPurple + , thinline + ) + |> center + |> name ("diamond" ++ label) + in + impose text shape box : String -> Collage msg box label = - let - text = - fromString label - |> rendered - w = width text + l - l = unit - shape = - rectangle w l - |> styled - ( uniform lightBlue - , thinline - ) - in - impose text shape + let + text = + fromString label + |> Text.typeface (Text.Font fontFamily) + |> Text.size Text.huge + |> rendered + + w = + width text + l + + l = + unit + + shape = + rectangle w l + |> styled + ( uniform lightBlue + , thinline + ) + in + impose text shape dot : Collage msg dot = - circle (unit / 3) - |> styled - ( uniform green - , thinline - ) + circle (unit) + |> styled + ( uniform green + , thinline + ) arrow : Float -> Collage msg arrow length = - let - body = - line length - |> traced thinline - |> rotate (pi / 2) - tip = - triangle (unit / 3) - |> filled (uniform black) - |> rotate pi - in - --FIXME: add markers - vertical [ body, tip ] + let + body = + line length + |> traced thinline + |> rotate (pi / 2) + + tip = + triangle (unit / 3) + |> filled (uniform black) + |> rotate pi + in + --FIXME: add markers + vertical [ body, tip ] @@ -145,97 +176,132 @@ arrow length = render : Flow -> Collage msg render flow = - let - addBottomArrow max flow_ = - vertical - [ flow_ - , arrow (max - height flow_) - ] - addBottomLine max flow_ = - vertical - [ flow_ - , line (max - height flow_) - |> traced thinline - |> rotate (pi / 2) - ] - branches finishing flows = - let - prerendered = - flows - |> List.map render - h = - prerendered - |> group - |> height - --NOTE: this is the length of a normal arrow - |> (+) unit - in - prerendered - |> List.map (finishing h) - |> List.intersperse space - |> horizontal - |> center - in - case flow of - Finish -> - vertical - [ arrow unit - , dot - ] - Task string -> - vertical - [ arrow unit - , box string - ] - Sequence flow1 flow2 -> - vertical - [ render flow1 - , render flow2 - ] - Choice condition left right -> - let - ( leftBranch, rightBranch ) = ( render left, render right ) - maxHeight = max (height leftBranch) (height rightBranch) + unit - inner = - horizontal - [ leftBranch - |> addBottomLine maxHeight - |> name "leftBranch" - , space - , rightBranch - |> addBottomLine maxHeight - |> name "rightBranch" - ] - |> shift ( -(envelope Right leftBranch + unit + envelope Left rightBranch) / 2, 0 ) - in - vertical - [ arrow unit - , inner - |> connect [ ( "leftBranch", top ), ( "rightBranch", top ) ] thinline - |> connect [ ( "leftBranch", bottom ), ( "rightBranch", bottom ) ] thinline - |> at top (diamond condition) - |> at bottom (diamond "") - ] - Parallel flows -> - let - inner = branches addBottomArrow flows - bar = - line (width inner + unit) - |> traced thickline - in - vertical - [ arrow unit - , bar - , inner - , bar - ] + let + addBottomArrow max flow_ = + vertical + [ flow_ + , arrow (max - height flow_) + ] + + addBottomLine max flow_ = + vertical + [ flow_ + , line (max - height flow_) + |> traced thinline + |> rotate (pi / 2) + ] + + branches finishing flows = + let + prerendered = + flows + |> List.map render + + h = + prerendered + |> group + |> height + --NOTE: this is the length of a normal arrow + |> (+) unit + in + prerendered + |> List.map (finishing h) + |> List.intersperse space + |> horizontal + |> center + in + case flow of + Finish -> + vertical + [ arrow unit + , dot + ] + + Task string -> + vertical + [ arrow unit + , box string + ] + + Sequence flow1 flow2 -> + vertical + [ render flow1 + , render flow2 + ] + + Choice condition left right -> + let + ( leftBranch, rightBranch ) = + ( render left, render right ) + + maxHeight = + max (height leftBranch) (height rightBranch) + unit + + inner = + horizontal + [ leftBranch + |> addBottomLine maxHeight + |> name "leftBranch" + , space + , rightBranch + |> addBottomLine maxHeight + |> name "rightBranch" + ] + |> shift ( -(envelope Right leftBranch + unit + envelope Left rightBranch) / 2, 0 ) + in + vertical + [ arrow unit + , inner + |> at top (diamond condition) + |> at bottom (diamond "") + |> connect [ ( "leftBranch", top ), ( "diamonddiff is as wished", Layout.left ) ] thinline + |> connect [ ( "diamonddiff is as wished", Layout.right ), ( "rightBranch", Layout.top ) ] thinline + |> connect [ ( "leftBranch", bottom ), ( "diamond", Layout.left ) ] thinline + |> connect [ ( "diamond", Layout.right ), ( "rightBranch", Layout.bottom ) ] thinline + ] + + Parallel flows -> + let + inner = + branches addBottomArrow flows + + bar = + line (width inner + unit) + |> traced thickline + in + vertical + [ arrow unit + , bar + , inner + , bar + ] -- Main ------------------------------------------------------------------------ -main : Html msg +type Msg + = NoOp + + +type alias Model = + Flow + + +main : Platform.Program () (Example.Model Msg Model) (Example.Msg Msg) main = - render example - |> svg + Example.example + { init = example + , update = (\_ model -> model) + , render = render + , view = view + } + + +view : Html Msg -> Html Msg +view collage = + Html.div [] + [ Html.node "link" [ Html.Attributes.href ("https://fonts.googleapis.com/css2?family=" ++ fontFamily ++ "&display=swap"), Html.Attributes.rel "stylesheet" ] [] + , collage + ] diff --git a/examples/House.elm b/examples/House.elm index d92d87f..3b131b2 100644 --- a/examples/House.elm +++ b/examples/House.elm @@ -1,10 +1,9 @@ module House exposing (house, main) -import Browser import Collage exposing (..) +import Example import Collage.Events exposing (..) import Collage.Layout exposing (..) -import Collage.Render exposing (..) import Color exposing (..) import Html exposing (Html) @@ -27,21 +26,18 @@ type Part | Handle -init : Model -init = { hover = None } - - - -- Update ---------------------------------------------------------------------- -type alias Msg = - Part +type Msg + = ChangePart Part update : Msg -> Model -> Model update msg model = - { hover = msg } + case msg of + ChangePart part -> + { model | hover = part } @@ -60,19 +56,19 @@ house model = else fill ) - |> onMouseEnter (always part) + |> onMouseEnter (always <| ChangePart part) --TODO: add `lengthen 0.75` - roof = interactive Roof (uniform blue) (triangle 1) - door = interactive Door (uniform red) (rectangle 0.2 0.4) - handle = interactive Handle (uniform black) (circle 0.02) - wall = interactive Wall (uniform yellow) (square 1) - chimney = interactive Chimney (uniform green) (rectangle 0.1 0.4) + roof = interactive Roof (uniform blue) (triangle 100) + door = interactive Door (uniform red) (rectangle 20 40) + handle = interactive Handle (uniform black) (circle 2) + wall = interactive Wall (uniform yellow) (square 100) + chimney = interactive Chimney (uniform green) (rectangle 10 40) smoke = let puff p = - interactive Smoke (uniform gray) (circle 0.05) + interactive Smoke (uniform gray) (circle 5) |> shift p - puffs = List.map puff [ ( 0, 0 ), ( 0.05, 0.15 ) ] + puffs = List.map puff [ ( 0, 0 ), ( 5, 15 ) ] in stack puffs in @@ -80,37 +76,29 @@ house model = [ stack [ roof , chimney - |> at (top >> (\( x, y ) -> ( x, y + 0.15 ))) smoke - |> shift ( 0.25, 0 ) + |> at (top >> (\( x, y ) -> ( x, y + 15 ))) smoke + |> shift ( 25, 0 ) ] |> center , stack - [ handle |> shift ( 0.05, 0.2 ) + [ handle |> shift ( 5, 20 ) , door |> align bottom , wall |> align bottom ] ] -view : Model -> Html Msg -view model = - house model - |> scale 200 - |> svg - - - -- Main ------------------------------------------------------------------------ -main : Program () Model Msg +main : Platform.Program () (Example.Model Msg Model) (Example.Msg Msg) main = - Browser.sandbox - { init = init - , view = view - , update = update - } - + Example.example + { init = Model None + , update = update + , render = house >> (scale 2) + , view = identity + } {- Compare https://archives.haskell.org/projects.haskell.org/diagrams/blog/2015-04-30-GTK-coordinates.html: diff --git a/examples/Lines.elm b/examples/Lines.elm index 3bbe3bb..61b2658 100644 --- a/examples/Lines.elm +++ b/examples/Lines.elm @@ -1,8 +1,8 @@ module Lines exposing (lines, main) +import Example import Collage exposing (..) import Collage.Layout exposing (..) -import Collage.Render exposing (svg) import Color exposing (..) import Html exposing (Html) @@ -24,8 +24,7 @@ lines = List.map hline [ ultrathin, verythin, thin, semithick, thick, verythick, ultrathick ] -main : Html msg -main = +collage = horizontal [ gap , vertical @@ -34,4 +33,13 @@ main = , gap ] ] - |> svg + +main : Platform.Program () (Example.Model () (Collage ())) (Example.Msg ()) +main = + Example.example + { init = collage + , update = (\_ _ -> collage) + , render = (\_ -> collage) + , view = identity + } + diff --git a/examples/Path.elm b/examples/Path.elm index 8064965..fc1d0bc 100644 --- a/examples/Path.elm +++ b/examples/Path.elm @@ -1,16 +1,39 @@ module Path exposing (main) +import Example import Collage exposing (..) -import Collage.Render exposing (svg) +import Collage.Layout exposing (..) import Color exposing (..) import Html exposing (Html) zigzag : Collage msg zigzag = - path [ ( 0, 50 ), ( 50, 0 ), ( 50, 50 ) ] - |> traced (solid thin (uniform red)) + let + points = + [ ( 0, 50 ) + , ( 50, 0 ) + , ( 50, 50 ) + , ( 100, 0 ) + , ( 100, 50 ) + , ( 150, 0 ) + ] + in + vertical + [ path points + |> traced (solid thin (uniform red)) + , spacer 0 20 + , curve points + |> traced (solid thin (uniform red)) + , spacer 0 20 + ] -main : Html msg -main = zigzag |> svg +main : Platform.Program () (Example.Model () (Collage ())) (Example.Msg ()) +main = + Example.example + { init = zigzag + , update = (\_ _ -> zigzag) + , render = (\_ -> zigzag) + , view = identity + } diff --git a/examples/Simple.elm b/examples/Simple.elm index 60b9e48..79cc6b7 100644 --- a/examples/Simple.elm +++ b/examples/Simple.elm @@ -1,14 +1,14 @@ module Simple exposing (main) -import Collage exposing (circle, filled, rectangle, uniform) +import Example +import Collage exposing (Collage, circle, filled, rectangle, uniform) import Collage.Layout exposing (at, topLeft) import Collage.Render exposing (svg) import Color import Html exposing (Html) -main : Html msg -main = +collage = let circ = circle 50 @@ -19,4 +19,13 @@ main = in rect |> at topLeft circ - |> svg + + +main : Platform.Program () (Example.Model () (Collage ())) (Example.Msg ()) +main = + Example.example + { init = collage + , update = (\_ _ -> collage) + , render = (\_ -> collage) + , view = identity + } diff --git a/examples/Thickness.elm b/examples/Thickness.elm new file mode 100644 index 0000000..150f59c --- /dev/null +++ b/examples/Thickness.elm @@ -0,0 +1,83 @@ +module Thickness exposing (main) + +import Collage exposing (..) +import Collage.Layout exposing (..) +import Collage.Render exposing (svg) +import Color +import Example +import Html exposing (Html) + + +collage = + let + thicknesses = + [ ultrathin, verythin, thin, semithick, thick, verythick, ultrathick ] + in + horizontal + [ vertical + (thicknesses + |> List.concatMap (\t -> [ spacer 10 10, diamond t ]) + ) + , vertical + (thicknesses + |> List.concatMap (\t -> [ spacer 10 15, zigzag t ]) + ) + ] + + +diamond : Float -> Collage msg +diamond thickness = + let + unit = + 100 + + w = + unit + + l = + unit / 2 + + points = + [ ( 0, l ) + , ( -l, 0 ) + , ( 0, -l ) + , ( w, -l ) + , ( w + l, 0 ) + , ( w, l ) + ] + in + polygon points + |> styled + ( uniform Color.lightPurple + , solid thickness (uniform Color.blue) + ) + |> center + + +zigzag : Float -> Collage msg +zigzag thickness = + let + top = + [ ( 0, 50 ) + , ( 50, 0 ) + , ( 50, 50 ) + , ( 100, 0 ) + , ( 100, 50 ) + , ( 150, 0 ) + ] + + bottom = + top |> List.map (\( x, y ) -> ( x - 20, y + 50 )) |> List.reverse + in + polygon (top ++ bottom) + |> styled ( uniform Color.red, solid thickness (uniform Color.black) ) + + +main : Platform.Program () (Example.Model () (Collage ())) (Example.Msg ()) +main = + Example.example + { init = collage + , update = \_ _ -> collage + , render = \_ -> collage + , view = identity + } diff --git a/examples/elm.json b/examples/elm.json index 1c522e9..34a44a6 100644 --- a/examples/elm.json +++ b/examples/elm.json @@ -4,7 +4,7 @@ ".", "../src/" ], - "elm-version": "0.19.0", + "elm-version": "0.19.1", "dependencies": { "direct": { "avh4/elm-color": "1.0.0", @@ -25,4 +25,4 @@ "direct": {}, "indirect": {} } -} \ No newline at end of file +} diff --git a/src/Collage.elm b/src/Collage.elm index 0fec202..4ab46e7 100644 --- a/src/Collage.elm +++ b/src/Collage.elm @@ -4,7 +4,7 @@ module Collage exposing , group , Shape, rectangle, square, roundedRectangle, roundedSquare, ellipse, circle, polygon, ngon, triangle , filled, outlined, styled - , Path, line, segment, path + , Path, line, segment, path, curve , traced, close , rendered , image, html @@ -143,13 +143,10 @@ Ok, you get the grip! # Paths -_Please fill in an issue if you want support for curves and arcs (aka Bézier paths). -I like to know if people want this before implementing it._ - ## Drawing paths -@docs Path, line, segment, path +@docs Path, line, segment, path, curve ## Turning paths into collages or shapes @@ -628,7 +625,7 @@ type alias Path = -- Creating paths -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --- TODO: add curves (aka Bezier paths), arcs (part of Bezier paths) +-- TODO: add arcs (part of Bezier paths) {-| Draw a horizontal line with a given length. @@ -674,6 +671,11 @@ path : List Point -> Path path = Core.Polyline +{-| Create a curve that goes through a sequence of points. +-} +curve : List Point -> Path +curve = Core.Curve + -- Turning paths into collages -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- - {- diff --git a/src/Collage/Core.elm b/src/Collage/Core.elm index fa44e96..a817c34 100644 --- a/src/Collage/Core.elm +++ b/src/Collage/Core.elm @@ -6,6 +6,7 @@ Constructors are however not exposed to the user. import Color exposing (Color) import Helpers +import Helpers.List import Html exposing (Html) import Json.Decode as Json @@ -108,7 +109,7 @@ foldr f acc col = foldrLazy : (Collage fill line text msg -> (() -> a) -> a) -> a -> Collage fill line text msg -> a foldrLazy f acc col = let - foldrOf = Helpers.foldrLazy (\c a -> foldrLazy f (a ()) c) acc + foldrOf = Helpers.List.foldrLazy (\c a -> foldrLazy f (a ()) c) acc recurse () = case col.basic of Group cols -> foldrOf cols @@ -213,6 +214,7 @@ type Shape type Path = Polyline (List Point) + | Curve (List Point) type Text style diff --git a/src/Collage/Layout.elm b/src/Collage/Layout.elm index b0af3bd..4d35af8 100644 --- a/src/Collage/Layout.elm +++ b/src/Collage/Layout.elm @@ -123,6 +123,7 @@ import Collage.Super exposing (..) import Color import Dict exposing (Dict) import Helpers +import Helpers.List import Maybe exposing (withDefault) @@ -269,6 +270,8 @@ handleBasic basic = thickness ) ps + Core.Path attrs (Core.Curve ps) -> + handleBasic (Core.Path attrs (Core.Polyline ps)) -- Boxes -- Core.Text dims _ -> handleBox 0 dims @@ -791,7 +794,7 @@ locate string anchor this = firstOf = --NOTE: This saves us recursing down when we found what we're looking for! --FIXME: This is depth first!!! - Helpers.foldrLazy (Helpers.orLazy << recurse) Nothing + Helpers.List.foldrLazy (Helpers.orLazy << recurse) Nothing in if match then Just <| anchor col @@ -869,7 +872,7 @@ connect locations line col = positions = locations |> List.map (\( n, a ) -> locate n a col) - |> Helpers.values + |> Helpers.List.values in impose (path positions |> traced line) col diff --git a/src/Collage/Render.elm b/src/Collage/Render.elm index d26c79b..c59be5c 100644 --- a/src/Collage/Render.elm +++ b/src/Collage/Render.elm @@ -19,8 +19,9 @@ import List import Maybe exposing (withDefault) import String exposing (fromFloat, fromInt) import Svg exposing (Attribute, Svg) -import Svg.Attributes as Svg -import Svg.Events as Svg +import Array exposing (Array) +import Svg.Attributes as Attrs +import Svg.Events as Events import Tuple @@ -65,9 +66,9 @@ svgAbsolute ( width, height ) collage = Html.div [] [ Svg.svg - [ Svg.width w - , Svg.height h - , Svg.version "1.1" + [ Attrs.width w + , Attrs.height h + , Attrs.version "1.1" ] [ render collage ] ] @@ -83,19 +84,30 @@ render collage = case path of Core.Polyline ps -> Svg.polyline - ([ Svg.id name - , Svg.points <| decodePoints ps + ([ Attrs.id name + , Attrs.points <| decodePoints ps ] ++ attrs collage ++ events collage.handlers ) [] + + Core.Curve ps -> + Svg.path + ([ Attrs.id name + , Attrs.d (decodeCurve (ps |> List.map (\(x1, y1) -> (x1, -y1)))) + ] + ++ attrs collage + ++ events collage.handlers + ) + [] + Core.Shape ( fill, line ) shape -> case shape of Core.Polygon ps -> Svg.polygon - ([ Svg.id name - , Svg.points <| decodePoints ps + ([ Attrs.id name + , Attrs.points <| decodePoints ps ] ++ attrs collage ++ events collage.handlers @@ -103,8 +115,8 @@ render collage = [] Core.Circle r -> Svg.circle - ([ Svg.id name - , Svg.r <| fromFloat r + ([ Attrs.id name + , Attrs.r <| fromFloat r ] ++ attrs collage ++ events collage.handlers @@ -112,9 +124,9 @@ render collage = [] Core.Ellipse rx ry -> Svg.ellipse - ([ Svg.id name - , Svg.rx <| fromFloat rx - , Svg.ry <| fromFloat ry + ([ Attrs.id name + , Attrs.rx <| fromFloat rx + , Attrs.ry <| fromFloat ry ] ++ attrs collage ++ events collage.handlers @@ -122,9 +134,9 @@ render collage = [] Core.Rectangle w h r -> Svg.rect - ([ Svg.id name - , Svg.rx <| fromFloat r - , Svg.ry <| fromFloat r + ([ Attrs.id name + , Attrs.rx <| fromFloat r + , Attrs.ry <| fromFloat r ] ++ box w h ++ attrs collage @@ -136,15 +148,15 @@ render collage = render { collage | basic = Core.Path line path } Core.Text _ (Core.Chunk style str) -> Svg.text_ - ([ Svg.id name ] + ([ Attrs.id name ] ++ attrs collage ++ events collage.handlers ) [ Svg.text str ] Core.Image ( w, h ) url -> Svg.image - ([ Svg.id name - , Svg.xlinkHref url + ([ Attrs.id name + , Attrs.xlinkHref url ] ++ box w h ++ attrs collage @@ -153,7 +165,7 @@ render collage = [] Core.Html ( w, h ) extraAttrs html -> Svg.foreignObject - ([ Svg.id name ] + ([ Attrs.id name ] ++ box w h ++ attrs collage ++ events collage.handlers @@ -162,7 +174,7 @@ render collage = [ html ] Core.Group collages -> --NOTE: Order of collages is reversed here! Svg renders group elements from back to front. - Svg.g (Svg.id name :: attrs collage ++ events collage.handlers) <| + Svg.g (Attrs.id name :: attrs collage ++ events collage.handlers) <| List.foldl (\col res -> render col :: res) [] collages Core.Subcollage fore back -> --NOTE: Rendering a subcollage is the same as rendering a group, only layout calculations in `Collage.Layout` differ. @@ -171,56 +183,56 @@ render collage = box : Float -> Float -> List (Attribute msg) box w h = - [ Svg.width <| fromFloat w - , Svg.height <| fromFloat h - , Svg.x <| fromFloat (-w / 2) - , Svg.y <| fromFloat (-h / 2) + [ Attrs.width <| fromFloat w + , Attrs.height <| fromFloat h + , Attrs.x <| fromFloat (-w / 2) + , Attrs.y <| fromFloat (-h / 2) ] events : List ( String, Json.Decoder msg ) -> List (Attribute msg) events handlers = - List.map (uncurry Svg.on) handlers + List.map (uncurry Events.on) handlers attrs : Collage msg -> List (Attribute msg) attrs collage = case collage.basic of Core.Path line _ -> - [ Svg.stroke <| decodeFill line.fill - , Svg.strokeOpacity <| decodeFillOpacity line.fill - , Svg.strokeWidth <| fromFloat line.thickness - , Svg.strokeLinecap <| decodeCap line.cap - , Svg.strokeLinejoin <| decodeJoin line.join - , Svg.fill <| "none" - , Svg.opacity <| fromFloat collage.opacity - , Svg.transform <| decodeTransform collage - , Svg.strokeDashoffset <| fromInt line.dashPhase - , Svg.strokeDasharray <| decodeDashing line.dashPattern + [ Attrs.stroke <| decodeFill line.fill + , Attrs.strokeOpacity <| decodeFillOpacity line.fill + , Attrs.strokeWidth <| fromFloat line.thickness + , Attrs.strokeLinecap <| decodeCap line.cap + , Attrs.strokeLinejoin <| decodeJoin line.join + , Attrs.fill <| "none" + , Attrs.opacity <| fromFloat collage.opacity + , Attrs.transform <| decodeTransform collage + , Attrs.strokeDashoffset <| fromInt line.dashPhase + , Attrs.strokeDasharray <| decodeDashing line.dashPattern ] Core.Shape ( fill, line ) _ -> - [ Svg.fill <| decodeFill fill - , Svg.fillOpacity <| decodeFillOpacity fill - , Svg.stroke <| decodeFill line.fill - , Svg.strokeOpacity <| decodeFillOpacity line.fill - , Svg.strokeWidth <| fromFloat line.thickness - , Svg.strokeLinecap <| decodeCap line.cap - , Svg.strokeLinejoin <| decodeJoin line.join - , Svg.opacity <| fromFloat collage.opacity - , Svg.transform <| decodeTransform collage - , Svg.strokeDashoffset <| fromInt line.dashPhase - , Svg.strokeDasharray <| decodeDashing line.dashPattern + [ Attrs.fill <| decodeFill fill + , Attrs.fillOpacity <| decodeFillOpacity fill + , Attrs.stroke <| decodeFill line.fill + , Attrs.strokeOpacity <| decodeFillOpacity line.fill + , Attrs.strokeWidth <| fromFloat line.thickness + , Attrs.strokeLinecap <| decodeCap line.cap + , Attrs.strokeLinejoin <| decodeJoin line.join + , Attrs.opacity <| fromFloat collage.opacity + , Attrs.transform <| decodeTransform collage + , Attrs.strokeDashoffset <| fromInt line.dashPhase + , Attrs.strokeDasharray <| decodeDashing line.dashPattern ] Core.Text _ (Core.Chunk style str) -> - [ Svg.fill <| decodeFill (Core.Uniform style.color) - , Svg.fontFamily <| + [ Attrs.fill <| decodeFill (Core.Uniform style.color) + , Attrs.fontFamily <| case style.typeface of Text.Serif -> "serif" Text.Sansserif -> "sans-serif" Text.Monospace -> "monospace" Text.Font name -> name - , Svg.fontSize <| fromInt style.size - , Svg.fontWeight <| + , Attrs.fontSize <| fromInt style.size + , Attrs.fontWeight <| case style.weight of Text.Thin -> "200" Text.Light -> "300" @@ -229,30 +241,30 @@ attrs collage = Text.SemiBold -> "600" Text.Bold -> "bold" Text.Black -> "800" - , Svg.fontStyle <| + , Attrs.fontStyle <| case style.shape of Text.Upright -> "normal" Text.SmallCaps -> "normal" Text.Slanted -> "oblique" Text.Italic -> "italic" - , Svg.fontVariant <| + , Attrs.fontVariant <| case style.shape of Text.SmallCaps -> "small-caps" _ -> "normal" - , Svg.textDecoration <| + , Attrs.textDecoration <| case style.line of Text.None -> "none" Text.Under -> "underline" Text.Over -> "overline" Text.Through -> "line-through" - , Svg.textAnchor <| "middle" - , Svg.dominantBaseline "middle" - , Svg.opacity <| fromFloat collage.opacity - , Svg.transform <| decodeTransform collage + , Attrs.textAnchor <| "middle" + , Attrs.dominantBaseline "middle" + , Attrs.opacity <| fromFloat collage.opacity + , Attrs.transform <| decodeTransform collage ] _ -> - [ Svg.opacity <| fromFloat collage.opacity - , Svg.transform <| decodeTransform collage + [ Attrs.opacity <| fromFloat collage.opacity + , Attrs.transform <| decodeTransform collage ] @@ -330,3 +342,58 @@ decodeDashing ds = ds |> List.map decodeOnOff |> String.join " " + + +-- BASED ON https://github.com/rough-stuff/rough/blob/e9b0fdf36952a7a0f02e8015f4abac1ad39981c5/src/renderer.ts#L367 +decodeCurve : List Point -> String +decodeCurve ps = + let + toString = + (round >> fromInt) + + neighbors i xs = + let + l = Array.length xs - 1 + in + Maybe.map4 (\m1 p0 p1 p2 -> (m1, p0, (p1, p2))) -- use tuples so we can destructure ( x, y ) + (Array.get (max (i - 1) 0) xs) -- previous with first element as lower bound + (Array.get i xs) + (Array.get (i + 1) xs) -- if sequent doesnt exist, we're ready and results in Nothing + (Array.get (min (i + 2) l) xs) -- subsequent with last element as upper bound + in + case ps of + [] -> + "" + + [ _ ] -> + "" + + [ (x1, y1), (x2, y2) ] -> + [ "M", fromFloat x1, fromFloat y1 + , "L", fromFloat x2, fromFloat y2 + ] |> String.join " " + + (x1, y1) :: tail -> + let + arr = Array.fromList ps + curves = + Array.indexedMap (\i p -> + case (neighbors i arr) of + Just ((m1x, m1y), (p0x, p0y), ((p1x, p1y), (p2x, p2y))) -> + [ "C" + , p0x + (p1x - m1x) / 6 |> toString + , p0y + (p1y - m1y) / 6 |> toString + , "," + , p1x + (p0x - p2x) / 6 |> toString + , p1y + (p0y - p2y) / 6 |> toString + , "," + , p1x |> toString + , p1y |> toString + ] |> String.join " " + Nothing -> + "" + ) arr + |> Array.toList + + in + ([ "M", fromFloat x1, fromFloat y1 ] ++ curves) |> String.join " " diff --git a/src/Collage/Sketchy.elm b/src/Collage/Sketchy.elm new file mode 100644 index 0000000..4177eca --- /dev/null +++ b/src/Collage/Sketchy.elm @@ -0,0 +1,234 @@ +module Collage.Sketchy exposing (Config, defaultConfig, sketchy, nextSeed) + +{-| Transform a collage so it looks rough and hand drawn. + +@docs Config, defaultConfig, sketchy, nextSeed + +-} + +import Array +import Collage exposing (Collage, Point) +import Collage.Core as Core +import Collage.Sketchy.Fill as Fill +import Helpers.List exposing (rotate, segments) + + +{-| Configure how rough results should look. + + - `roughness` controls how far points will be shifted from original locations. + - `bowing` controls depth of curvature between two points on a line. Currently only responds to 0 or 1 values. + - `seed` controls random number generator. Reuse the same seed to reproduce an identical sketched collage. + +-} +type alias Config = + { roughness : Float + , bowing : Float + , seed : Int + } + + +{-| Default configuration values. + + { roughness = 2, bowing = 1, seed = 0 } + +-} +defaultConfig : Config +defaultConfig = + { roughness = 2, bowing = 1, seed = 0 } + + +{-| Helper for incrementing the seed value to generate a new randomized Sketchy collage. + + sketchy (nextSeed config) collage + +-} +nextSeed : Config -> Config +nextSeed config = + { config | seed = config.seed + 1 } + + +{-| Generate a sketched version of a collage. + + sketchy defaultConfig collage + |> Collage.Render.svg + +-} +sketchy : Config -> Collage msg -> Collage msg +sketchy config collage = + case collage.basic of + Core.Path style path -> + let + sketchPolyline ps = + sketchSegments False config ps + |> List.map (\segment -> Collage.curve segment |> Collage.traced style) + + sketchCurve ps = + [ sketchPoints config ps + , sketchPoints (nextSeed config) ps + ] + |> List.map (\c -> Collage.curve c |> Collage.traced style) + in + case path of + Core.Polyline ps -> + { collage | basic = Core.Group (sketchPolyline ps) } + + Core.Curve ps -> + { collage | basic = Core.Group (sketchCurve ps) } + + Core.Shape ( fill, line ) path -> + let + sketchPolygon ps = + sketchSegments True config ps + |> List.map (\segment -> Collage.curve segment |> Collage.traced line) + + hachureThickness = + max 1 (line.thickness - 1) + + sketchFill ps = + Fill.hachureLines hachureThickness ps + |> List.indexedMap (\i ends -> sketchPoints { config | seed = config.seed + i, roughness = 1 } ends |> Collage.curve) + |> List.map (Collage.solid hachureThickness fill |> Collage.traced) + + sketchEllipse ps = + sketchPoints { config | bowing = 0 } (ps ++ rotate ps) + |> Collage.curve + |> Collage.traced line + in + case path of + Core.Polygon ps -> + { collage | basic = Core.Group <| sketchPolygon ps ++ sketchFill ps } + + Core.Rectangle w h r -> + let + ps = + [ ( -w / 2, -h / 2 ) + , ( w / 2, -h / 2 ) + , ( w / 2, h / 2 ) + , ( -w / 2, h / 2 ) + ] + in + { collage | basic = Core.Group <| sketchPolygon ps ++ sketchFill ps } + + Core.Circle r -> + let + ps = + ellipsePoints 8 r r + + fillPs = + ellipsePoints 16 r r + in + { collage | basic = Core.Group <| [ sketchEllipse ps ] ++ sketchFill fillPs } + + Core.Ellipse rx ry -> + let + ps = + ellipsePoints 8 rx ry + + fillPs = + ellipsePoints 16 rx ry + in + { collage | basic = Core.Group <| [ sketchEllipse ps ] ++ sketchFill fillPs } + + _ -> + collage + + Core.Group collages -> + List.map (sketchy (nextSeed config)) collages + |> (\group -> { collage | basic = Core.Group group }) + + Core.Subcollage fore back -> + (\sketchedFore sketchedBack -> { collage | basic = Core.Subcollage sketchedFore sketchedBack }) + (sketchy (nextSeed config) fore) + (sketchy (nextSeed config) back) + + _ -> + collage + + + +-- INTERNAL + + +sketchSegments : Bool -> Config -> List Point -> List (List Point) +sketchSegments closed config ps = + segments closed ps + |> List.concatMap (\( a, b ) -> [ sketchPoints config [ a, b ], sketchPoints (nextSeed config) [ a, b ] ]) + + +sketchPoints : Config -> List Point -> List Point +sketchPoints config ps = + let + bowedPs = + if config.bowing == 0 then + ps + + else + segments True ps + |> List.map + (\( ( x1, y1 ), ( x2, y2 ) ) -> + [ ( x1, y1 ) + , ( x1 + (x2 - x1) / 2, y1 + (y2 - y1) / 2 ) + ] + ) + |> List.concat + |> List.take ((List.length ps * 2) - 1) + + lineLength = + segments True ps + |> List.map + (\( ( x1, y1 ), ( x2, y2 ) ) -> (x2 - x1) ^ 2 + (y2 - y1) ^ 2 |> sqrt) + |> List.take (List.length ps) + |> List.sum + + roughness = + (if lineLength > 200 then + 1 + + else if lineLength > 500 then + 0.4 + + else + lineLength / 100 + ) + * config.roughness + + randomOffset i = + ( random (config.seed + i) * roughness, random (config.seed + i + 1) * roughness ) + in + List.indexedMap + (\i ( x, y ) -> + let + ( shiftX, shiftY ) = + randomOffset (i * 2) + in + ( x + shiftX, y + shiftY ) + ) + bowedPs + + +ellipsePoints : Int -> Float -> Float -> List Point +ellipsePoints count rx ry = + List.range 0 count + |> List.map + (\i -> + toFloat i + |> (*) (360 / toFloat count) + |> (-) 90 + |> degrees + |> (\angle -> ( rx * cos angle, ry * sin angle )) + ) + + +{-| Faster and easier way to shift points randomly. + +Generated manually: + + $ ruby -e "puts 100.times.map{|i| Random.new.rand(-1.0..1.0).round(2) }.to_s" + +-} +random : Int -> Float +random i = + [ -0.99, -0.33, -0.84, 0.24, 0.45, 0.25, -0.63, -0.36, -0.4, -0.99, 0.21, -0.14, -0.96, -0.28, -0.17, 0.58, -0.65, 0.36, 0.38, -0.44, -0.33, 0.36, -0.72, -0.76, -0.92, -0.89, -0.82, -0.53, 0.25, 0.2, -0.9, -0.83, 0.22, 0.27, 0.05, -0.38, 0.68, -0.25, 0.8, 0.47, 0.62, 0.39, 0.74, -0.09, 0.23, -0.97, 0.21, 0.88, -0.32, -0.96, 0.01, -0.25, -0.99, -0.37, -0.73, -0.42, -0.54, 0.01, 0.95, -0.11, -0.59, -0.65, -0.28, 0.14, -0.22, -0.98, -0.9, 0.19, 0.35, 0.06, 0.53, 0.89, -0.01, 0.98, -0.35, 0.91, 0.49, 0.18, -0.99, 0.54, 0.45, -0.11, -0.91, -0.75, -0.61, -0.21, 0.9, 0.97, 0.68, 0.51, -0.18, 0.66, -0.05, 0.11, 0.98, 0.87, -0.88, 0.2, -0.82, -0.01 ] + |> Array.fromList + |> Array.get (modBy 100 i) + |> Maybe.withDefault 0.5 diff --git a/src/Collage/Sketchy/Fill.elm b/src/Collage/Sketchy/Fill.elm new file mode 100644 index 0000000..5326008 --- /dev/null +++ b/src/Collage/Sketchy/Fill.elm @@ -0,0 +1,123 @@ +module Collage.Sketchy.Fill exposing (hachureLines) + +import Collage exposing (..) +import Collage.Core as Core exposing (FillStyle(..)) +import Helpers.List +import Color exposing (..) + + + +-- BASED ON: https://github.com/rough-stuff/rough/blob/e9b0fdf36952a7a0f02e8015f4abac1ad39981c5/src/fillers/scan-line-hachure.ts + + +type alias Edge = + { ymin : Float + , ymax : Float + , x : Float + , islope : Float + } + + +hachureAngle = + -45 + + +hachureLines : Float -> List Point -> List (List Point) +hachureLines thickness vertices = + let + edges = + rotatePoints (degrees hachureAngle) vertices + |> Helpers.List.segments True + |> List.filterMap segmentToEdge + |> List.sortWith sortEdges + + ymin = + List.head edges + |> Maybe.map .ymin + |> Maybe.withDefault 0 + + ymax = + List.reverse edges + |> List.head + |> Maybe.map .ymax + |> Maybe.withDefault 0 + + yValues = + List.range (round ymin) (round ymax) + |> List.filter (\i -> modBy (ceiling thickness) i == 0) + |> List.map toFloat + in + yValues + |> List.concatMap (horizontalLine edges) + |> List.map (rotatePoints (degrees -hachureAngle)) + + +horizontalLine : List Edge -> Float -> List (List Point) +horizontalLine edges y = + List.map (\e -> { e | x = e.x + (y - e.ymin) * e.islope }) edges + |> List.filter (\e -> e.ymin <= y && e.ymax > y) + |> List.sortBy .x + |> (\l -> + case l of + [] -> + [] + + [ a, b ] -> + [ [ ( a.x, y ), ( b.x, y ) ] ] + + list -> + pairs list + |> List.map (\( a, b ) -> [ ( a.x, y ), ( b.x, y ) ]) + ) + + +segmentToEdge : ( Point, Point ) -> Maybe Edge +segmentToEdge ( ( x1, y1 ), ( x2, y2 ) ) = + if y1 == y2 then + Nothing + + else + { ymin = min y1 y2 + , ymax = max y1 y2 + , x = + if y1 <= y2 then + x1 + + else + x2 + , islope = + (x2 - x1) / (y2 - y1) + } + |> Just + + +sortEdges : Edge -> Edge -> Basics.Order +sortEdges a b = + if a.ymin /= b.ymin then + compare a.ymin b.ymin + + else if a.x /= b.x then + compare a.x b.x + + else + compare a.ymax b.ymax + + +rotatePoints : Float -> List Point -> List Point +rotatePoints radians ps = + List.map + (\( x, y ) -> + ( x * cos radians - y * sin radians + , x * sin radians + y * cos radians + ) + ) + ps + + +pairs : List a -> List ( a, a ) +pairs list = + List.map2 Tuple.pair list (Helpers.List.rotate list) + |> List.indexedMap Tuple.pair + |> List.filter (\( i, _ ) -> modBy 2 i == 0) + |> List.unzip + |> Tuple.second diff --git a/src/Helpers.elm b/src/Helpers.elm index 09585ca..22ff02a 100644 --- a/src/Helpers.elm +++ b/src/Helpers.elm @@ -1,11 +1,10 @@ module Helpers exposing - ( foldrLazy - , orLazy - , values + ( orLazy ) {-| -} + -- Maybe ----------------------------------------------------------------------- @@ -16,30 +15,3 @@ orLazy ma fmb = case ma of Nothing -> fmb () Just _ -> ma - - -{-| Convert a list of `Maybe a` to a list of `a` only for the values different from `Nothing`. - - values [ Just 1, Nothing, Just 2 ] == [ 1, 2 ] - --} -values : List (Maybe a) -> List a -values = List.foldr foldrValues [] - - -foldrValues : Maybe a -> List a -> List a -foldrValues item list = - case item of - Nothing -> list - Just v -> v :: list - - - --- List ------------------------------------------------------------------------ - - -foldrLazy : (e -> (() -> a) -> a) -> a -> List e -> a -foldrLazy f acc list = - case list of - [] -> acc - x :: xs -> f x (\() -> foldrLazy f acc xs) diff --git a/src/Helpers/List.elm b/src/Helpers/List.elm new file mode 100644 index 0000000..6251d17 --- /dev/null +++ b/src/Helpers/List.elm @@ -0,0 +1,50 @@ +module Helpers.List exposing + ( values + , foldrLazy + , rotate + , segments + ) + + +{-| Convert a list of `Maybe a` to a list of `a` only for the values different from `Nothing`. + + values [ Just 1, Nothing, Just 2 ] == [ 1, 2 ] + +-} +values : List (Maybe a) -> List a +values = List.foldr foldrValues [] + + +foldrValues : Maybe a -> List a -> List a +foldrValues item list = + case item of + Nothing -> list + Just v -> v :: list + + +foldrLazy : (e -> (() -> a) -> a) -> a -> List e -> a +foldrLazy f acc list = + case list of + [] -> acc + x :: xs -> f x (\() -> foldrLazy f acc xs) + + +rotate : List a -> List a +rotate list = + case list of + head :: tail -> + tail ++ [ head ] + + _ -> + list + + +segments : Bool -> List a -> List ( a, a ) +segments closed ps = + List.map2 Tuple.pair ps (rotate ps) + |> (if closed then + identity + + else + List.take (List.length ps - 1) + )