mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-14 09:32:22 +00:00
Work on a high-level API. Rewrite examples.
This commit is contained in:
David
parent
721064a73a
commit
7f9b3f1da2
7 changed files with 148 additions and 131 deletions
93
README.md
93
README.md
|
|
@ -21,23 +21,23 @@ The example gifs are displayed at 25 fps.
|
|||
```haskell
|
||||
latex_draw :: Ani ()
|
||||
latex_draw = pauseAtEnd 1 $ defineAnimation $ proc () -> do
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
emit -< toHtml $ mkBackground "black"
|
||||
drawText msg `andThen` fillText msg -< ()
|
||||
where
|
||||
msg = "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"
|
||||
placement = g_ [transform_ $ translate 20 15 <> " " <> scale 5 5]
|
||||
placement = translate (320/2) (180/2) . scale 5
|
||||
fillText txt = defineAnimation $ proc () -> do
|
||||
duration 1 -< ()
|
||||
s <- signal 0 1 -< ()
|
||||
emit -< placement $
|
||||
g_ [fill_ "white", num_ fill_opacity_ s] $
|
||||
toHtml $ latexAlign txt
|
||||
emit -< toHtml $ placement $
|
||||
withFillColor "white" $ withFillOpacity s $
|
||||
center $ latexAlign txt
|
||||
drawText txt = defineAnimation $ proc () -> do
|
||||
duration 2 -< ()
|
||||
s <- signal 0 1 -< ()
|
||||
emit -< placement $
|
||||
g_ [stroke_ "white", fill_opacity_ "0", stroke_width_ "0.1"] $
|
||||
toHtml $ partialSvg s $ latexAlign txt
|
||||
emit -< toHtml $ placement $
|
||||
withStrokeColor "white" $ withFillOpacity 0 $ withStrokeWidth (Num 0.1) $
|
||||
partialSvg s $ center $ latexAlign txt
|
||||
```
|
||||
|
||||
|
||||
|
|
@ -54,27 +54,19 @@ bbox1 :: Ani ()
|
|||
bbox1 = defineAnimation $ proc () -> do
|
||||
duration 5 -< ()
|
||||
s <- signal 0 1 -< ()
|
||||
let rotated = rotate (360*s) svg
|
||||
(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"]
|
||||
g_ [fill_ "white"] $ toHtml rotated
|
||||
toHtml $ mkBoundingBox $ rotate (360*s) svg
|
||||
toHtml $ withFillColor "white" $ rotate (360*s) svg
|
||||
where
|
||||
msg = "\\sum_{k=1}^\\infty"
|
||||
svg = scale 3 $ center $ latexAlign msg
|
||||
svg = scale 3 $ center $ latexAlign "\\sum_{k=1}^\\infty"
|
||||
|
||||
bbox2 :: Ani ()
|
||||
bbox2 = defineAnimation $ proc () -> do
|
||||
duration 5 -< ()
|
||||
s <- signalOscillate 0 1 -< ()
|
||||
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"]
|
||||
g_ [fill_ "white", fill_opacity_ "0", stroke_width_ "4", stroke_ "white"] $
|
||||
toHtml rotated
|
||||
toHtml $ mkBoundingBox $ partialSvg s heartShape
|
||||
toHtml $ withStrokeColor "white" $ withFillOpacity 0 $ partialSvg s heartShape
|
||||
```
|
||||
|
||||
|
||||
|
|
@ -88,21 +80,19 @@ bbox2 = defineAnimation $ proc () -> do
|
|||
sinewave :: Ani ()
|
||||
sinewave = proc () -> do
|
||||
duration 10 -< ()
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
|
||||
emit -< toHtml $ mkBackground "black"
|
||||
idx <- signalOscillate 0 1 -< ()
|
||||
emit -< do
|
||||
defs_ $ clipPath_ [id_ "clip"] $
|
||||
rect_ [x_ "0", num_ y_ (-height), num_ width_ (idx * width), height_ "100%"]
|
||||
g_ [transform_ $ translate margin height, clip_path_ "url(#clip)"] $
|
||||
renderPath $ approxFnData 1000 wave
|
||||
line_ [ num_ x1_ margin, num_ x2_ margin, y1_ "10", y2_ "170"
|
||||
, stroke_ "white"]
|
||||
line_ [num_ x1_ margin, num_ x2_ (margin+width), num_ y1_ height, num_ y2_ height
|
||||
, stroke_ "white"]
|
||||
|
||||
defs_ $ clipPath_ [id_ "clip"] $ toHtml $
|
||||
mkRect (Num 0, Num (-height)) (Num $ idx*width) (Percent 100)
|
||||
toHtml $ translate margin height $ withStrokeColor "white" $
|
||||
withClipPathRef (Ref "clip") $ mkPathText $ renderPathText $ approxFnData 1000 wave
|
||||
toHtml $ withStrokeColor "white" $
|
||||
mkLine (Num margin, Num 10) (Num margin, Num 170)
|
||||
toHtml $ withStrokeColor "white" $
|
||||
mkLine (Num margin, Num height) (Num (margin+width), Num height)
|
||||
let (circX, circY) = wave idx
|
||||
emit -< g_ [transform_ $ translate margin height] $
|
||||
emit -< g_ [transform_ $ Lucid.translate margin height] $
|
||||
circle_ [num_ cx_ circX, num_ cy_ circY, r_ "3", fill_ "red"]
|
||||
where
|
||||
freq = 3; margin = 30; width = 260; height = 90
|
||||
|
|
@ -114,22 +104,20 @@ sinewave = proc () -> do
|
|||
## Morphing wave
|
||||
|
||||
```haskell
|
||||
morph_wave :: Ani ()
|
||||
morph_wave = proc () -> do
|
||||
morph_wave_circle :: Ani ()
|
||||
morph_wave_circle = proc t -> do
|
||||
duration 5 -< ()
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
|
||||
morph <- signalOscillate 0 1 -< ()
|
||||
emit -< do
|
||||
g_ [transform_ $ translate 30 50] $ renderPath wave1
|
||||
g_ [transform_ $ translate 30 130] $ renderPath wave2
|
||||
g_ [transform_ $ translate 30 90] $ renderPath $ morphPath wave1 wave2 morph
|
||||
line_ [x1_ "30", x2_ "30", y1_ "10", y2_ "170", stroke_ "white"]
|
||||
line_ [x1_ "30", x2_ "290", y1_ "90", y2_ "90", stroke_ "white"]
|
||||
idx <- signalOscillate 0 1 -< ()
|
||||
emit -< toHtml $ withStrokeColor "white" $ mkGroup
|
||||
[ mkBackground "black"
|
||||
, translate 30 90 $ mkPathText $ renderPathText $ morphPath circle wave1 idx
|
||||
, mkLine (Num 30, Num 10) (Num 30, Num 170)
|
||||
, mkLine (Num 30, Num 90) (Num 290, Num 90) ]
|
||||
where
|
||||
freq = 3; width = 260
|
||||
freq = 5; width = 260; radius = 50
|
||||
wave1 = approxFnData 1000 $ \idx -> (idx*width, sin (idx*pi*2*freq) * 20)
|
||||
wave2 = approxFnData 1000 $ \idx -> (idx*width, sin (idx*pi*2*(freq*3)) * 20)
|
||||
circle = approxFnData 1000 $ \idx ->
|
||||
(cos (idx*pi*2+pi/2)*radius + width/2, sin (idx*pi*2+pi/2)*radius)
|
||||
```
|
||||
|
||||
|
||||
|
|
@ -239,12 +227,13 @@ latex_basic :: Ani ()
|
|||
latex_basic = proc () -> do
|
||||
duration 2 -< ()
|
||||
s <- signalOscillate 0 1 -< ()
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
emit -<
|
||||
g_ [transform_ $ translate 20 15 <> " " <> scale 4 4] $ do
|
||||
g_ [stroke_ "white", fill_opacity_ "0", stroke_width_ "0.1"] text
|
||||
g_ [fill_ "white", num_ fill_opacity_ s] text
|
||||
emit -< toHtml $ mkGroup
|
||||
[ mkBackground "black"
|
||||
, translate (320/2) (180/2) $ mkGroup
|
||||
[ withStrokeColor "white" $ withFillOpacity 0 $ withStrokeWidth (Num 0.1) text
|
||||
, withFillColor "white" $ withFillOpacity s text] ]
|
||||
where
|
||||
text = latex "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"
|
||||
text = scale 4 $ center $ latexAlign
|
||||
"\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"
|
||||
```
|
||||
|
||||
|
|
|
|||
Binary file not shown.
|
Before Width: | Height: | Size: 170 KiB After Width: | Height: | Size: 128 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 110 KiB After Width: | Height: | Size: 111 KiB |
|
|
@ -27,8 +27,8 @@ library
|
|||
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,
|
||||
JuicyPixels
|
||||
containers, svg-tree >= 0.6.2.3, xml, bytestring, lens, linear, mtl, matrix,
|
||||
JuicyPixels, attoparsec
|
||||
|
||||
Flag gtk-viewer
|
||||
Description: Enable gtk-based viewer
|
||||
|
|
@ -52,7 +52,7 @@ executable reanimate-viewer
|
|||
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,JuicyPixels
|
||||
filepath, process, directory, containers, svg-tree >= 0.6.2.3, xml,
|
||||
bytestring, lens, linear, mtl, matrix,JuicyPixels, attoparsec
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ import Codec.Picture.Types
|
|||
import Data.Monoid
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (Text, pack)
|
||||
import qualified Graphics.Svg as S
|
||||
import Graphics.Svg as S
|
||||
import Linear.V2
|
||||
import Lucid.Svg (Svg, circle_, clip_path_, cx_, cy_, d_, id_, defs_, clipPath_,
|
||||
fill_, fill_opacity_, font_size_, g_,
|
||||
|
|
@ -32,19 +32,17 @@ import Debug.Trace
|
|||
sinewave :: Ani ()
|
||||
sinewave = proc () -> do
|
||||
duration 10 -< ()
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
|
||||
emit -< toHtml $ mkBackground "black"
|
||||
idx <- signalOscillate 0 1 -< ()
|
||||
emit -< do
|
||||
defs_ $ clipPath_ [id_ "clip"] $
|
||||
rect_ [x_ "0", num_ y_ (-height), num_ width_ (idx * width), height_ "100%"]
|
||||
g_ [transform_ $ Lucid.translate margin height, clip_path_ "url(#clip)"] $
|
||||
renderPath $ approxFnData 1000 wave
|
||||
line_ [ num_ x1_ margin, num_ x2_ margin, y1_ "10", y2_ "170"
|
||||
, stroke_ "white"]
|
||||
line_ [num_ x1_ margin, num_ x2_ (margin+width), num_ y1_ height, num_ y2_ height
|
||||
, stroke_ "white"]
|
||||
|
||||
defs_ $ clipPath_ [id_ "clip"] $ toHtml $
|
||||
mkRect (Num 0, Num (-height)) (Num $ idx*width) (Percent 100)
|
||||
toHtml $ translate margin height $ withStrokeColor "white" $
|
||||
withClipPathRef (Ref "clip") $ mkPathText $ renderPathText $ approxFnData 1000 wave
|
||||
toHtml $ withStrokeColor "white" $
|
||||
mkLine (Num margin, Num 10) (Num margin, Num 170)
|
||||
toHtml $ withStrokeColor "white" $
|
||||
mkLine (Num margin, Num height) (Num (margin+width), Num height)
|
||||
let (circX, circY) = wave idx
|
||||
emit -< g_ [transform_ $ Lucid.translate margin height] $
|
||||
circle_ [num_ cx_ circX, num_ cy_ circY, r_ "3", fill_ "red"]
|
||||
|
|
@ -55,15 +53,14 @@ sinewave = proc () -> do
|
|||
morph_wave :: Ani ()
|
||||
morph_wave = proc () -> do
|
||||
duration 5 -< ()
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
|
||||
morph <- signalOscillate 0 1 -< ()
|
||||
emit -< do
|
||||
g_ [transform_ $ Lucid.translate 30 50] $ renderPath wave1
|
||||
g_ [transform_ $ Lucid.translate 30 130] $ renderPath wave2
|
||||
g_ [transform_ $ Lucid.translate 30 90] $ renderPath $ morphPath wave1 wave2 morph
|
||||
line_ [x1_ "30", x2_ "30", y1_ "10", y2_ "170", stroke_ "white"]
|
||||
line_ [x1_ "30", x2_ "290", y1_ "90", y2_ "90", stroke_ "white"]
|
||||
emit -< toHtml $ withStrokeColor "white" $ mkGroup
|
||||
[ mkBackground "black"
|
||||
, translate 30 50 $ mkPathText $ renderPathText wave1
|
||||
, translate 30 130 $ mkPathText $ renderPathText wave2
|
||||
, translate 30 90 $ mkPathText $ renderPathText $ morphPath wave1 wave2 morph
|
||||
, mkLine (Num 30, Num 10) (Num 30, Num 170)
|
||||
, mkLine (Num 30, Num 90) (Num 290, Num 90) ]
|
||||
where
|
||||
freq = 3; width = 260
|
||||
wave1 = approxFnData 1000 $ \idx -> (idx*width, sin (idx*pi*2*freq) * 20)
|
||||
|
|
@ -71,15 +68,13 @@ morph_wave = proc () -> do
|
|||
|
||||
morph_wave_circle :: Ani ()
|
||||
morph_wave_circle = proc t -> do
|
||||
duration 5 -< ()
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
|
||||
idx <- signalOscillate 0 1 -< ()
|
||||
emit -< do
|
||||
g_ [transform_ $ Lucid.translate 30 90] $
|
||||
renderPath $ morphPath circle wave1 idx
|
||||
line_ [x1_ "30", x2_ "30", y1_ "10", y2_ "170", stroke_ "white"]
|
||||
line_ [x1_ "30", x2_ "290", y1_ "90", y2_ "90", stroke_ "white"]
|
||||
duration 5 -< ()
|
||||
idx <- signalOscillate 0 1 -< ()
|
||||
emit -< toHtml $ withStrokeColor "white" $ mkGroup
|
||||
[ mkBackground "black"
|
||||
, translate 30 90 $ mkPathText $ renderPathText $ morphPath circle wave1 idx
|
||||
, mkLine (Num 30, Num 10) (Num 30, Num 170)
|
||||
, mkLine (Num 30, Num 90) (Num 290, Num 90) ]
|
||||
where
|
||||
freq = 5; width = 260; radius = 50
|
||||
wave1 = approxFnData 1000 $ \idx -> (idx*width, sin (idx*pi*2*freq) * 20)
|
||||
|
|
@ -357,13 +352,14 @@ latex_basic :: Ani ()
|
|||
latex_basic = proc () -> do
|
||||
duration 2 -< ()
|
||||
s <- signalOscillate 0 1 -< ()
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
emit -<
|
||||
g_ [transform_ $ Lucid.translate 20 15 <> " " <> Lucid.scale 4 4] $ do
|
||||
g_ [stroke_ "white", fill_opacity_ "0", stroke_width_ "0.1"] text
|
||||
g_ [fill_ "white", num_ fill_opacity_ s] text
|
||||
emit -< toHtml $ mkGroup
|
||||
[ mkBackground "black"
|
||||
, translate (320/2) (180/2) $ mkGroup
|
||||
[ withStrokeColor "white" $ withFillOpacity 0 $ withStrokeWidth (Num 0.1) text
|
||||
, withFillColor "white" $ withFillOpacity s text] ]
|
||||
where
|
||||
text = toHtml $ latexAlign "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"
|
||||
text = scale 4 $ center $ latexAlign
|
||||
"\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"
|
||||
|
||||
bezier :: Ani ()
|
||||
bezier = adjustSpeed 0.4 $ proc () -> do
|
||||
|
|
@ -428,28 +424,28 @@ pathSquare = proc () -> do
|
|||
|
||||
latex_draw :: Ani ()
|
||||
latex_draw = pauseAtEnd 1 $ defineAnimation $ proc () -> do
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
emit -< toHtml $ mkBackground "black"
|
||||
drawText msg `andThen` fillText msg -< ()
|
||||
where
|
||||
msg = "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"
|
||||
placement = g_ [transform_ $ Lucid.translate 20 15 <> " " <> Lucid.scale 5 5]
|
||||
placement = translate (320/2) (180/2) . scale 5
|
||||
fillText txt = defineAnimation $ proc () -> do
|
||||
duration 1 -< ()
|
||||
s <- signal 0 1 -< ()
|
||||
emit -< placement $
|
||||
g_ [fill_ "white", num_ fill_opacity_ s] $
|
||||
toHtml $ latexAlign txt
|
||||
emit -< toHtml $ placement $
|
||||
withFillColor "white" $ withFillOpacity s $
|
||||
center $ latexAlign txt
|
||||
drawText txt = defineAnimation $ proc () -> do
|
||||
duration 2 -< ()
|
||||
s <- signal 0 1 -< ()
|
||||
emit -< placement $
|
||||
g_ [stroke_ "white", fill_opacity_ "0", stroke_width_ "0.1"] $
|
||||
toHtml $ partialSvg s $ latexAlign txt
|
||||
emit -< toHtml $ placement $
|
||||
withStrokeColor "white" $ withFillOpacity 0 $ withStrokeWidth (Num 0.1) $
|
||||
partialSvg s $ center $ latexAlign txt
|
||||
|
||||
|
||||
bbox :: Ani ()
|
||||
bbox = proc () -> do
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
emit -< toHtml $ mkBackground "black"
|
||||
annotate' bbox1 -< g_ [transform_ $ Lucid.translate (320/2-50) (180/2)]
|
||||
annotate' bbox2 -< g_ [transform_ $ Lucid.translate (320/2+50) (180/2)]
|
||||
|
||||
|
|
@ -457,37 +453,28 @@ bbox1 :: Ani ()
|
|||
bbox1 = defineAnimation $ proc () -> do
|
||||
duration 5 -< ()
|
||||
s <- signal 0 1 -< ()
|
||||
let rotated = rotate (360*s) svg
|
||||
(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"]
|
||||
g_ [fill_ "white"] $ toHtml rotated
|
||||
toHtml $ mkBoundingBox $ rotate (360*s) svg
|
||||
toHtml $ withFillColor "white" $ rotate (360*s) svg
|
||||
where
|
||||
msg = "\\sum_{k=1}^\\infty"
|
||||
svg = scale 3 $ center $ latexAlign msg
|
||||
svg = scale 3 $ center $ latexAlign "\\sum_{k=1}^\\infty"
|
||||
|
||||
bbox2 :: Ani ()
|
||||
bbox2 = defineAnimation $ proc () -> do
|
||||
duration 5 -< ()
|
||||
s <- signalOscillate 0 1 -< ()
|
||||
let rotated = partialSvg s heartShape
|
||||
(x, y, w, h) = boundingBox rotated
|
||||
emit -< do
|
||||
toHtml $ withStrokeColor "red" $ withFillOpacity 0 $
|
||||
mkRect (S.Num x, S.Num y) (S.Num w) (S.Num h)
|
||||
toHtml $ withStrokeColor "white" $ withFillOpacity 0 $
|
||||
rotated
|
||||
toHtml $ mkBoundingBox $ partialSvg s heartShape
|
||||
toHtml $ withStrokeColor "white" $ withFillOpacity 0 $ partialSvg s heartShape
|
||||
|
||||
mkBoundingBox :: Tree -> Tree
|
||||
mkBoundingBox svg = withStrokeColor "red" $ withFillOpacity 0 $
|
||||
mkRect (S.Num x, S.Num y) (S.Num w) (S.Num h)
|
||||
where
|
||||
(x, y, w, h) = boundingBox svg
|
||||
|
||||
heartShape =
|
||||
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 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]
|
||||
rotate 225 $ center $ mkPathString
|
||||
"M0.0,40.0 v-40.0 h40.0\
|
||||
\a20.0 20.0 90.0 0 1 0.0,40.0\
|
||||
\a20.0 20.0 90.0 0 1 -40.0,0.0 Z"
|
||||
|
|
|
|||
|
|
@ -4,10 +4,14 @@ import Codec.Picture (PixelRGBA8 (..))
|
|||
import Control.Lens (over, set, (%~), (&), (.~), (^.))
|
||||
import Control.Monad.Fix
|
||||
import Control.Monad.State
|
||||
import Control.Arrow
|
||||
import Data.Attoparsec.Text (parseOnly)
|
||||
import Data.List
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import Graphics.Svg
|
||||
import Graphics.Svg.PathParser
|
||||
import Linear.Metric
|
||||
import Linear.V2
|
||||
import Linear.Vector
|
||||
|
|
@ -16,6 +20,9 @@ import qualified Reanimate.Transform as Transform
|
|||
|
||||
import Debug.Trace
|
||||
|
||||
defaultDPI :: Dpi
|
||||
defaultDPI = 96
|
||||
|
||||
replaceUses :: Document -> Document
|
||||
replaceUses doc = doc & elements %~ map (mapTree replace)
|
||||
& definitions .~ Map.empty
|
||||
|
|
@ -33,7 +40,6 @@ replaceUses doc = doc & elements %~ map (mapTree replace)
|
|||
case (toUserUnit defaultDPI x, toUserUnit defaultDPI y) of
|
||||
(Num a, Num b) -> Translate a b
|
||||
_ -> TransformUnknown
|
||||
defaultDPI = 96
|
||||
docTree = GroupTree $ set groupChildren (doc^.elements) defaultSvg
|
||||
idMap = foldTree updMap Map.empty docTree `Map.union`
|
||||
Map.mapMaybe elementToTree (doc^.definitions)
|
||||
|
|
@ -319,12 +325,20 @@ svgBoundingPoints t = map (Transform.transformPoint m) $
|
|||
PolyLineTree{} -> error "PolyLineTree"
|
||||
EllipseTree{} -> error "EllipseTree"
|
||||
LineTree{} -> error "LineTree"
|
||||
RectangleTree{} -> error "RectangleTree"
|
||||
RectangleTree rect ->
|
||||
-- toUserUnit defaultDPI x
|
||||
case mapTuple (toUserUnit defaultDPI) (rect^.rectUpperLeftCorner) of
|
||||
(Num x, Num y) -> [V2 x y] ++
|
||||
case mapTuple (toUserUnit defaultDPI) (rect^.rectWidth, rect^.rectHeight) of
|
||||
(Num w, Num h) -> [V2 (x+w) (y+h)]
|
||||
_ -> []
|
||||
_ -> []
|
||||
TextTree{} -> []
|
||||
ImageTree{} -> []
|
||||
MeshGradientTree{} -> []
|
||||
where
|
||||
m = Transform.mkMatrix (t^.drawAttr.transform)
|
||||
mapTuple f = f *** f
|
||||
|
||||
withTransformations :: [Transformation] -> Tree -> Tree
|
||||
withTransformations transformations = withDrawAttributes (transform .~ Just transformations)
|
||||
|
|
@ -365,14 +379,41 @@ mkColor name =
|
|||
withStrokeColor :: String -> Tree -> Tree
|
||||
withStrokeColor color = withDrawAttributes (strokeColor .~ pure (mkColor color))
|
||||
|
||||
withFillColor :: String -> Tree -> Tree
|
||||
withFillColor color = withDrawAttributes (fillColor .~ pure (mkColor color))
|
||||
|
||||
withFillOpacity :: Double -> Tree -> Tree
|
||||
withFillOpacity opacity = withDrawAttributes (fillOpacity .~ Just (realToFrac opacity))
|
||||
|
||||
withStrokeWidth :: Number -> Tree -> Tree
|
||||
withStrokeWidth width = withDrawAttributes (strokeWidth .~ pure width)
|
||||
|
||||
withClipPathRef :: ElementRef -> Tree -> Tree
|
||||
withClipPathRef ref = withDrawAttributes (clipPathRef .~ pure ref)
|
||||
|
||||
mkRect :: Point -> Number -> Number -> Tree
|
||||
mkRect corner width height = RectangleTree $
|
||||
defaultSvg & rectUpperLeftCorner .~ corner
|
||||
& rectWidth .~ width
|
||||
& rectHeight .~ height
|
||||
mkRect corner width height = RectangleTree $ defaultSvg
|
||||
& rectUpperLeftCorner .~ corner
|
||||
& rectWidth .~ width
|
||||
& rectHeight .~ height
|
||||
|
||||
mkLine :: Point -> Point -> Tree
|
||||
mkLine point1 point2 = LineTree $ defaultSvg
|
||||
& linePoint1 .~ point1
|
||||
& linePoint2 .~ point2
|
||||
|
||||
mkGroup :: [Tree] -> Tree
|
||||
mkGroup forest = GroupTree $ defaultSvg
|
||||
& groupChildren .~ forest
|
||||
|
||||
mkPathString :: String -> Tree
|
||||
mkPathString = mkPathText . T.pack
|
||||
|
||||
mkPathText :: T.Text -> Tree
|
||||
mkPathText str =
|
||||
case parseOnly pathParser str of
|
||||
Left err -> error err
|
||||
Right cmds -> PathTree $ defaultSvg & pathDefinition .~ cmds
|
||||
|
||||
mkBackground :: String -> Tree
|
||||
mkBackground color = withFillColor color $ mkRect (Num 0, Num 0) (Percent 100) (Percent 100)
|
||||
|
|
|
|||
|
|
@ -7,4 +7,4 @@ extra-deps:
|
|||
- gtk-0.15.0@sha256:a76d280dbeefbe08cf021c31bcd51c09cda97ebee7934debbfc14e1da4220b78
|
||||
- svgcairo-0.13.1.1@sha256:145b6acce7306e84652376efb3f00e9194ccd8787a62d3f93fb539c4a3382a2e
|
||||
- lucid-svg-0.7.0.0@sha256:2a2d0fe51329e8b89f723a8e86e6ab8d150d7b205591fffe4c09d8d11e022f98
|
||||
|
||||
- svg-tree-0.6.2.3
|
||||
|
|
|
|||
Loading…
Reference in a new issue