From 985c52b6e9d667a3523aa1cb1b911c8a28acdf38 Mon Sep 17 00:00:00 2001 From: David Date: Mon, 18 Feb 2019 21:16:15 +0100 Subject: [PATCH] Move towards tree-svg. Former-commit-id: b5482d83e9073044f3049fb5a7f5b1722a5afde6 --- README.md | 4 +- reanimate.cabal | 7 +- src/Reanimate/Examples.hs | 22 +++-- src/Reanimate/Svg.hs | 48 +++++++--- src/Reanimate/Svg/NamedColors.hs | 157 +++++++++++++++++++++++++++++++ 5 files changed, 213 insertions(+), 25 deletions(-) create mode 100644 src/Reanimate/Svg/NamedColors.hs diff --git a/README.md b/README.md index 67ac15c..717b7d8 100644 --- a/README.md +++ b/README.md @@ -58,7 +58,7 @@ bbox1 = defineAnimation $ proc () -> do (x, y, w, h) = boundingBox rotated emit -< do g_ [transform_ $ Lucid.translate x y] $ - rect_ [num_ width_ w, num_ height_ h, stroke_ "red", fill_opacity_ "0", stroke_width_ "1"] + rect_ [num_ width_ w, num_ height_ h, stroke_ "red", fill_opacity_ "0"] g_ [fill_ "white"] $ toHtml rotated where msg = "\\sum_{k=1}^\\infty" @@ -72,7 +72,7 @@ bbox2 = defineAnimation $ proc () -> do (x, y, w, h) = boundingBox rotated emit -< do g_ [transform_ $ Lucid.translate x y] $ - rect_ [num_ width_ w, num_ height_ h, stroke_ "red", fill_opacity_ "0", stroke_width_ "1"] + rect_ [num_ width_ w, num_ height_ h, stroke_ "red", fill_opacity_ "0"] g_ [fill_ "white", fill_opacity_ "0", stroke_width_ "4", stroke_ "white"] $ toHtml rotated ``` diff --git a/reanimate.cabal b/reanimate.cabal index 59f21b1..70cdee3 100644 --- a/reanimate.cabal +++ b/reanimate.cabal @@ -24,9 +24,11 @@ library Reanimate.Svg Reanimate.Transform other-modules: Reanimate.Misc + Reanimate.Svg.NamedColors build-depends: base >=4.10 && <4.13, lucid-svg, time, text, unix, lucid, filepath, process, directory, - containers, svg-tree, xml, bytestring, lens, linear, mtl, matrix + containers, svg-tree, xml, bytestring, lens, linear, mtl, matrix, + JuicyPixels Flag gtk-viewer Description: Enable gtk-based viewer @@ -47,9 +49,10 @@ executable reanimate-viewer Reanimate.Svg Reanimate.Misc Reanimate.Transform + Reanimate.Svg.NamedColors build-depends: base >=4.10 && <4.13, cairo >=0.13 && <0.14, gtk, svgcairo, lucid-svg, time, text, unix, lucid, reanimate, filepath, process, directory, containers, svg-tree, xml, - bytestring, lens, linear, mtl, matrix + bytestring, lens, linear, mtl, matrix,JuicyPixels hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Reanimate/Examples.hs b/src/Reanimate/Examples.hs index 4d54a80..9023a26 100644 --- a/src/Reanimate/Examples.hs +++ b/src/Reanimate/Examples.hs @@ -6,6 +6,8 @@ module Reanimate.Examples where import Control.Arrow (returnA, (>>>)) import Control.Lens import Control.Monad +import Codec.Picture.Types +import Data.Monoid import Data.Monoid ((<>)) import Data.Text (Text, pack) import qualified Graphics.Svg as S @@ -459,7 +461,7 @@ bbox1 = defineAnimation $ proc () -> do (x, y, w, h) = boundingBox rotated emit -< do g_ [transform_ $ Lucid.translate x y] $ - rect_ [num_ width_ w, num_ height_ h, stroke_ "red", fill_opacity_ "0", stroke_width_ "1"] + rect_ [num_ width_ w, num_ height_ h, stroke_ "red", fill_opacity_ "0"] g_ [fill_ "white"] $ toHtml rotated where msg = "\\sum_{k=1}^\\infty" @@ -472,20 +474,20 @@ bbox2 = defineAnimation $ proc () -> do let rotated = partialSvg s heartShape (x, y, w, h) = boundingBox rotated emit -< do - g_ [transform_ $ Lucid.translate x y] $ - rect_ [num_ width_ w, num_ height_ h, stroke_ "red", fill_opacity_ "0", stroke_width_ "1"] - g_ [fill_ "white", fill_opacity_ "0", stroke_width_ "4", stroke_ "white"] $ - toHtml rotated + toHtml $ withStrokeColor "red" $ withFillOpacity 0 $ + mkRect (S.Num x, S.Num y) (S.Num w) (S.Num h) + toHtml $ withStrokeColor "white" $ withFillOpacity 0 $ + rotated heartShape = - scale 0.15 $ rotate 225 $ center $ p + rotate 225 $ center $ p where p = S.PathTree $ S.defaultSvg & S.pathDefinition .~ cmds abs = S.OriginAbsolute rel = S.OriginRelative cmds = - [S.MoveTo abs [V2 0 200] - ,S.VerticalTo rel [-200],S.HorizontalTo rel [200] - ,S.EllipticalArc rel [(100,100,90,False,True, V2 0 200)] - ,S.EllipticalArc rel [(100,100,90,False,True, V2 (-200) 0)] + [S.MoveTo abs [V2 0 40] + ,S.VerticalTo rel [-40],S.HorizontalTo rel [40] + ,S.EllipticalArc rel [(20,20,90,False,True, V2 0 40)] + ,S.EllipticalArc rel [(20,20,90,False,True, V2 (-40) 0)] ,S.EndPath] diff --git a/src/Reanimate/Svg.hs b/src/Reanimate/Svg.hs index 0df22b5..5938feb 100644 --- a/src/Reanimate/Svg.hs +++ b/src/Reanimate/Svg.hs @@ -1,16 +1,18 @@ module Reanimate.Svg where -import Control.Lens (over, set, (%~), (&), (.~), (^.)) -import Control.Monad.State +import Codec.Picture (PixelRGBA8 (..)) +import Control.Lens (over, set, (%~), (&), (.~), (^.)) import Control.Monad.Fix -import qualified Data.Map as Map -import Data.Maybe +import Control.Monad.State import Data.List +import qualified Data.Map as Map +import Data.Maybe import Graphics.Svg import Linear.Metric import Linear.V2 import Linear.Vector -import qualified Reanimate.Transform as Transform +import Reanimate.Svg.NamedColors +import qualified Reanimate.Transform as Transform import Debug.Trace @@ -74,10 +76,10 @@ data LineCommand lineToPath :: [LineCommand] -> [PathCommand] lineToPath = map worker where - worker (LineMove p) = MoveTo OriginAbsolute [p] - worker (LineDraw p) = LineTo OriginAbsolute [p] + worker (LineMove p) = MoveTo OriginAbsolute [p] + worker (LineDraw p) = LineTo OriginAbsolute [p] worker (LineBezier [a,b,c]) = CurveTo OriginAbsolute [(a,b,c)] - worker (LineBezier [a,b]) = QuadraticBezier OriginAbsolute [(a,b)] + worker (LineBezier [a,b]) = QuadraticBezier OriginAbsolute [(a,b)] partialLine :: Double -> [LineCommand] -> [LineCommand] partialLine alpha cmds = evalState (worker 0 cmds) zero @@ -120,7 +122,7 @@ toLineCommands ps = evalState (worker zero Nothing ps) zero (lcmds++) <$> worker startPos' (cmdToControlPoint $ last lcmds) cmds cmdToControlPoint (LineBezier points) = Just (last (init points)) -cmdToControlPoint _ = Nothing +cmdToControlPoint _ = Nothing toLineCommand :: RPoint -> Maybe RPoint -> PathCommand -> CmdM [LineCommand] toLineCommand startPos mbPrevControlPt cmd = do @@ -325,11 +327,14 @@ svgBoundingPoints t = map (Transform.transformPoint m) $ m = Transform.mkMatrix (t^.drawAttr.transform) withTransformations :: [Transformation] -> Tree -> Tree -withTransformations transformations tree = GroupTree $ defaultSvg +withTransformations transformations = withDrawAttributes (transform .~ Just transformations) + +withDrawAttributes :: (DrawAttributes -> DrawAttributes) -> Tree -> Tree +withDrawAttributes lens tree = GroupTree $ defaultSvg & drawAttr .~ attr & groupChildren .~ [tree] where - attr = defaultSvg & transform .~ Just transformations + attr = defaultSvg & lens translate :: Double -> Double -> Tree -> Tree translate x y = withTransformations [Translate x y] @@ -350,3 +355,24 @@ center :: Tree -> Tree center t = translate (-x-w/2) (-y-h/2) t where (x, y, w, h) = boundingBox t + +mkColor :: String -> Texture +mkColor name = + case Map.lookup name svgNamedColors of + Nothing -> ColorRef (PixelRGBA8 240 248 255 255) + Just c -> ColorRef c + +withStrokeColor :: String -> Tree -> Tree +withStrokeColor color = withDrawAttributes (strokeColor .~ pure (mkColor color)) + +withFillOpacity :: Double -> Tree -> Tree +withFillOpacity opacity = withDrawAttributes (fillOpacity .~ Just (realToFrac opacity)) + +withStrokeWidth :: Number -> Tree -> Tree +withStrokeWidth width = withDrawAttributes (strokeWidth .~ pure width) + +mkRect :: Point -> Number -> Number -> Tree +mkRect corner width height = RectangleTree $ + defaultSvg & rectUpperLeftCorner .~ corner + & rectWidth .~ width + & rectHeight .~ height diff --git a/src/Reanimate/Svg/NamedColors.hs b/src/Reanimate/Svg/NamedColors.hs new file mode 100644 index 0000000..903e745 --- /dev/null +++ b/src/Reanimate/Svg/NamedColors.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE OverloadedStrings #-} +module Reanimate.Svg.NamedColors( svgNamedColors ) where + +import qualified Data.Map as M +import Codec.Picture( PixelRGBA8( .. ) ) +import Data.Text( Text ) + +svgNamedColors :: M.Map String PixelRGBA8 +svgNamedColors = M.fromList + [ ("aliceblue" , PixelRGBA8 240 248 255 255) + , ("antiquewhite" , PixelRGBA8 250 235 215 255) + , ("aqua" , PixelRGBA8 0 255 255 255) + , ("aquamarine" , PixelRGBA8 127 255 212 255) + , ("azure" , PixelRGBA8 240 255 255 255) + , ("beige" , PixelRGBA8 245 245 220 255) + , ("bisque" , PixelRGBA8 255 228 196 255) + , ("black" , PixelRGBA8 0 0 0 255) + , ("blanchedalmond" , PixelRGBA8 255 235 205 255) + , ("blue" , PixelRGBA8 0 0 255 255) + , ("blueviolet" , PixelRGBA8 138 43 226 255) + , ("brown" , PixelRGBA8 165 42 42 255) + , ("burlywood" , PixelRGBA8 222 184 135 255) + , ("cadetblue" , PixelRGBA8 95 158 160 255) + , ("chartreuse" , PixelRGBA8 127 255 0 255) + , ("chocolate" , PixelRGBA8 210 105 30 255) + , ("coral" , PixelRGBA8 255 127 80 255) + , ("cornflowerblue" , PixelRGBA8 100 149 237 255) + , ("cornsilk" , PixelRGBA8 255 248 220 255) + , ("crimson" , PixelRGBA8 220 20 60 255) + , ("cyan" , PixelRGBA8 0 255 255 255) + , ("darkblue" , PixelRGBA8 0 0 139 255) + , ("darkcyan" , PixelRGBA8 0 139 139 255) + , ("darkgoldenrod" , PixelRGBA8 184 134 11 255) + , ("darkgray" , PixelRGBA8 169 169 169 255) + , ("darkgreen" , PixelRGBA8 0 100 0 255) + , ("darkgrey" , PixelRGBA8 169 169 169 255) + , ("darkkhaki" , PixelRGBA8 189 183 107 255) + , ("darkmagenta" , PixelRGBA8 139 0 139 255) + , ("darkolivegreen" , PixelRGBA8 85 107 47 255) + , ("darkorange" , PixelRGBA8 255 140 0 255) + , ("darkorchid" , PixelRGBA8 153 50 204 255) + , ("darkred" , PixelRGBA8 139 0 0 255) + , ("darksalmon" , PixelRGBA8 233 150 122 255) + , ("darkseagreen" , PixelRGBA8 143 188 143 255) + , ("darkslateblue" , PixelRGBA8 72 61 139 255) + , ("darkslategray" , PixelRGBA8 47 79 79 255) + , ("darkslategrey" , PixelRGBA8 47 79 79 255) + , ("darkturquoise" , PixelRGBA8 0 206 209 255) + , ("darkviolet" , PixelRGBA8 148 0 211 255) + , ("deeppink" , PixelRGBA8 255 20 147 255) + , ("deepskyblue" , PixelRGBA8 0 191 255 255) + , ("dimgray" , PixelRGBA8 105 105 105 255) + , ("dimgrey" , PixelRGBA8 105 105 105 255) + , ("dodgerblue" , PixelRGBA8 30 144 255 255) + , ("firebrick" , PixelRGBA8 178 34 34 255) + , ("floralwhite" , PixelRGBA8 255 250 240 255) + , ("forestgreen" , PixelRGBA8 34 139 34 255) + , ("fuchsia" , PixelRGBA8 255 0 255 255) + , ("gainsboro" , PixelRGBA8 220 220 220 255) + , ("ghostwhite" , PixelRGBA8 248 248 255 255) + , ("gold" , PixelRGBA8 255 215 0 255) + , ("goldenrod" , PixelRGBA8 218 165 32 255) + , ("gray" , PixelRGBA8 128 128 128 255) + , ("grey" , PixelRGBA8 128 128 128 255) + , ("green" , PixelRGBA8 0 128 0 255) + , ("greenyellow" , PixelRGBA8 173 255 47 255) + , ("honeydew" , PixelRGBA8 240 255 240 255) + , ("hotpink" , PixelRGBA8 255 105 180 255) + , ("indianred" , PixelRGBA8 205 92 92 255) + , ("indigo" , PixelRGBA8 75 0 130 255) + , ("ivory" , PixelRGBA8 255 255 240 255) + , ("khaki" , PixelRGBA8 240 230 140 255) + , ("lavender" , PixelRGBA8 230 230 250 255) + , ("lavenderblush" , PixelRGBA8 255 240 245 255) + , ("lawngreen" , PixelRGBA8 124 252 0 255) + , ("lemonchiffon" , PixelRGBA8 255 250 205 255) + , ("lightblue" , PixelRGBA8 173 216 230 255) + , ("lightcoral" , PixelRGBA8 240 128 128 255) + , ("lightcyan" , PixelRGBA8 224 255 255 255) + , ("lightgoldenrodyellow", PixelRGBA8 250 250 210 255) + , ("lightgray" , PixelRGBA8 211 211 211 255) + , ("lightgreen" , PixelRGBA8 144 238 144 255) + , ("lightgrey" , PixelRGBA8 211 211 211 255) + , ("lightpink" , PixelRGBA8 255 182 193 255) + , ("lightsalmon" , PixelRGBA8 255 160 122 255) + , ("lightseagreen" , PixelRGBA8 32 178 170 255) + , ("lightskyblue" , PixelRGBA8 135 206 250 255) + , ("lightslategray" , PixelRGBA8 119 136 153 255) + , ("lightslategrey" , PixelRGBA8 119 136 153 255) + , ("lightsteelblue" , PixelRGBA8 176 196 222 255) + , ("lightyellow" , PixelRGBA8 255 255 224 255) + , ("lime" , PixelRGBA8 0 255 0 255) + , ("limegreen" , PixelRGBA8 50 205 50 255) + , ("linen" , PixelRGBA8 250 240 230 255) + , ("magenta" , PixelRGBA8 255 0 255 255) + , ("maroon" , PixelRGBA8 128 0 0 255) + , ("mediumaquamarine" , PixelRGBA8 102 205 170 255) + , ("mediumblue" , PixelRGBA8 0 0 205 255) + , ("mediumorchid" , PixelRGBA8 186 85 211 255) + , ("mediumpurple" , PixelRGBA8 147 112 219 255) + , ("mediumseagreen" , PixelRGBA8 60 179 113 255) + , ("mediumslateblue" , PixelRGBA8 123 104 238 255) + , ("mediumspringgreen" , PixelRGBA8 0 250 154 255) + , ("mediumturquoise" , PixelRGBA8 72 209 204 255) + , ("mediumvioletred" , PixelRGBA8 199 21 133 255) + , ("midnightblue" , PixelRGBA8 25 25 112 255) + , ("mintcream" , PixelRGBA8 245 255 250 255) + , ("mistyrose" , PixelRGBA8 255 228 225 255) + , ("moccasin" , PixelRGBA8 255 228 181 255) + , ("navajowhite" , PixelRGBA8 255 222 173 255) + , ("navy" , PixelRGBA8 0 0 128 255) + , ("oldlace" , PixelRGBA8 253 245 230 255) + , ("olive" , PixelRGBA8 128 128 0 255) + , ("olivedrab" , PixelRGBA8 107 142 35 255) + , ("orange" , PixelRGBA8 255 165 0 255) + , ("orangered" , PixelRGBA8 255 69 0 255) + , ("orchid" , PixelRGBA8 218 112 214 255) + , ("palegoldenrod" , PixelRGBA8 238 232 170 255) + , ("palegreen" , PixelRGBA8 152 251 152 255) + , ("paleturquoise" , PixelRGBA8 175 238 238 255) + , ("palevioletred" , PixelRGBA8 219 112 147 255) + , ("papayawhip" , PixelRGBA8 255 239 213 255) + , ("peachpuff" , PixelRGBA8 255 218 185 255) + , ("peru" , PixelRGBA8 205 133 63 255) + , ("pink" , PixelRGBA8 255 192 203 255) + , ("plum" , PixelRGBA8 221 160 221 255) + , ("powderblue" , PixelRGBA8 176 224 230 255) + , ("purple" , PixelRGBA8 128 0 128 255) + , ("red" , PixelRGBA8 255 0 0 255) + , ("rosybrown" , PixelRGBA8 188 143 143 255) + , ("royalblue" , PixelRGBA8 65 105 225 255) + , ("saddlebrown" , PixelRGBA8 139 69 19 255) + , ("salmon" , PixelRGBA8 250 128 114 255) + , ("sandybrown" , PixelRGBA8 244 164 96 255) + , ("seagreen" , PixelRGBA8 46 139 87 255) + , ("seashell" , PixelRGBA8 255 245 238 255) + , ("sienna" , PixelRGBA8 160 82 45 255) + , ("silver" , PixelRGBA8 192 192 192 255) + , ("skyblue" , PixelRGBA8 135 206 235 255) + , ("slateblue" , PixelRGBA8 106 90 205 255) + , ("slategray" , PixelRGBA8 112 128 144 255) + , ("slategrey" , PixelRGBA8 112 128 144 255) + , ("snow" , PixelRGBA8 255 250 250 255) + , ("springgreen" , PixelRGBA8 0 255 127 255) + , ("steelblue" , PixelRGBA8 70 130 180 255) + , ("tan" , PixelRGBA8 210 180 140 255) + , ("teal" , PixelRGBA8 0 128 128 255) + , ("thistle" , PixelRGBA8 216 191 216 255) + , ("tomato" , PixelRGBA8 255 99 71 255) + , ("turquoise" , PixelRGBA8 64 224 208 255) + , ("violet" , PixelRGBA8 238 130 238 255) + , ("wheat" , PixelRGBA8 245 222 179 255) + , ("white" , PixelRGBA8 255 255 255 255) + , ("whitesmoke" , PixelRGBA8 245 245 245 255) + , ("yellow" , PixelRGBA8 255 255 0 255) + , ("yellowgreen" , PixelRGBA8 154 205 50 255) + ]