mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-15 18:12:20 +00:00
Add basic support for bounding boxes.
This commit is contained in:
David
parent
58b5121ab9
commit
b8e7f0cb06
6 changed files with 337 additions and 108 deletions
|
|
@ -10,7 +10,13 @@ import Data.Monoid ((<>))
|
|||
import Data.Text (Text, pack)
|
||||
import qualified Graphics.Svg as S
|
||||
import Linear.V2
|
||||
import Lucid.Svg
|
||||
import Lucid.Svg (Svg, circle_, clip_path_, cx_, cy_, d_, id_, defs_, clipPath_,
|
||||
fill_, fill_opacity_, font_size_, g_,
|
||||
height_, line_, opacity_, path_, r_,
|
||||
rect_, stroke_, stroke_width_, text_,
|
||||
text_anchor_, toHtml, transform_,
|
||||
width_, x1_, x2_, x_, y1_, y2_, y_)
|
||||
import qualified Lucid.Svg as Lucid
|
||||
import Numeric
|
||||
import Text.Printf
|
||||
|
||||
|
|
@ -19,6 +25,8 @@ import Reanimate.Combinators
|
|||
import Reanimate.LaTeX
|
||||
import Reanimate.Svg
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
sinewave :: Ani ()
|
||||
sinewave = proc () -> do
|
||||
duration 10 -< ()
|
||||
|
|
@ -28,7 +36,7 @@ sinewave = proc () -> do
|
|||
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)"] $
|
||||
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"]
|
||||
|
|
@ -36,7 +44,7 @@ sinewave = proc () -> do
|
|||
, stroke_ "white"]
|
||||
|
||||
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
|
||||
|
|
@ -49,9 +57,9 @@ morph_wave = proc () -> do
|
|||
|
||||
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
|
||||
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"]
|
||||
where
|
||||
|
|
@ -66,7 +74,7 @@ morph_wave_circle = proc t -> do
|
|||
|
||||
idx <- signalOscillate 0 1 -< ()
|
||||
emit -< do
|
||||
g_ [transform_ $ translate 30 90] $
|
||||
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"]
|
||||
|
|
@ -79,9 +87,9 @@ morph_wave_circle = proc t -> do
|
|||
progressMeters :: Ani ()
|
||||
progressMeters = proc () -> do
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
annotate' (adjustSpeed 1.0 progressMeter) -< g_ [transform_ $ translate 40 20]
|
||||
annotate' (adjustSpeed 2.0 progressMeter) -< g_ [transform_ $ translate 140 20]
|
||||
annotate' (adjustSpeed 0.5 progressMeter) -< g_ [transform_ $ translate 240 20]
|
||||
annotate' (adjustSpeed 1.0 progressMeter) -< g_ [transform_ $ Lucid.translate 40 20]
|
||||
annotate' (adjustSpeed 2.0 progressMeter) -< g_ [transform_ $ Lucid.translate 140 20]
|
||||
annotate' (adjustSpeed 0.5 progressMeter) -< g_ [transform_ $ Lucid.translate 240 20]
|
||||
|
||||
emit -< do
|
||||
text_ [x_ "55", y_ "150", font_size_ "20"
|
||||
|
|
@ -164,10 +172,10 @@ clip_rect = proc () -> do
|
|||
where
|
||||
paintStatic nth = proc () ->
|
||||
annotate' (obj "white" (20+nth*10) (20+nth*10))
|
||||
-< g_ [transform_ $ translate 160 90]
|
||||
-< g_ [transform_ $ Lucid.translate 160 90]
|
||||
runAni color nth = defineAnimation $ proc () ->
|
||||
annotate' (circle_clip (obj color (20+nth*10) (20+nth*10)))
|
||||
-< g_ [transform_ $ translate 160 90]
|
||||
-< g_ [transform_ $ Lucid.translate 160 90]
|
||||
obj c width height = proc () -> do
|
||||
duration 1 -< ()
|
||||
emit -< rect_ [ num_ width_ width, num_ height_ height
|
||||
|
|
@ -195,7 +203,7 @@ circle_clip sub = proc () -> do
|
|||
scaling :: Ani ()
|
||||
scaling = adjustSpeed 2 $ syncAll
|
||||
[ defineAnimation $ proc () ->
|
||||
annotate' animation -< g_ [transform_ $ translate x y <> " " <> scale 0.5 0.5]
|
||||
annotate' animation -< g_ [transform_ $ Lucid.translate x y <> " " <> Lucid.scale 0.5 0.5]
|
||||
| x <- [0,160]
|
||||
, y <- [0,90]
|
||||
| animation <- [sinewave, morph_wave, highlight, progressMeters]]
|
||||
|
|
@ -210,7 +218,7 @@ heart :: Ani ()
|
|||
heart = proc () -> do
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "#FFFFFF"]
|
||||
-- duration 1 -< ()
|
||||
-- annotate' drawHeart -< g_ [transform_ $ scale 0.5 0.5 <> " " <> translate 200 200]
|
||||
-- annotate' drawHeart -< g_ [transform_ $ Lucid.scale 0.5 0.5 <> " " <> translate 200 200]
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
follow
|
||||
[ all_read
|
||||
|
|
@ -254,11 +262,11 @@ heart = proc () -> do
|
|||
heart_ani = repeatAni 10 $ defineAnimation $ proc () -> do
|
||||
duration 1 -< ()
|
||||
n <- signalOscillateSCurve 2 0.9 1.1 -< ()
|
||||
annotate' drawHeart -< g_ [transform_ $ translate 160 110] . g_ [transform_ $ scale n n <> " "]
|
||||
annotate' drawHeart -< g_ [transform_ $ Lucid.translate 160 110] . g_ [transform_ $ Lucid.scale n n <> " "]
|
||||
heart_disappear = defineAnimation $ proc () -> do
|
||||
duration 3 -< ()
|
||||
n <- signal 0.9 10 -< ()
|
||||
annotate' drawHeart -< g_ [transform_ $ translate 160 110] . g_ [transform_ $ scale n n <> " "]
|
||||
annotate' drawHeart -< g_ [transform_ $ Lucid.translate 160 110] . g_ [transform_ $ Lucid.scale n n <> " "]
|
||||
white = loop $ defineAnimation $ proc () -> do
|
||||
duration 1 -< ()
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "#FFFFFF"]
|
||||
|
|
@ -267,8 +275,8 @@ heart = proc () -> do
|
|||
n <- signal 0 1 -< ()
|
||||
o <- signalOscillate (-1) 1 -< ()
|
||||
emit -<
|
||||
g_ [transform_ $ translate (xPos*360) (210*n)] $
|
||||
g_ [transform_ $ rotate (45*o)] $
|
||||
g_ [transform_ $ Lucid.translate (xPos*360) (210*n)] $
|
||||
g_ [transform_ $ Lucid.rotate (45*o)] $
|
||||
text_ [font_size_ "18"
|
||||
,text_anchor_ "middle"
|
||||
,fill_ "red"] "爱"
|
||||
|
|
@ -277,16 +285,16 @@ heart = proc () -> do
|
|||
o <- signalOscillate 0 1 -< ()
|
||||
n <- signalOscillateSCurve 2 0.9 1.1 -< ()
|
||||
emit -<
|
||||
g_ [transform_ $ translate 160 110, num_ opacity_ o] $
|
||||
g_ [transform_ $ scale n n ] $
|
||||
g_ [transform_ $ Lucid.translate 160 110, num_ opacity_ o] $
|
||||
g_ [transform_ $ Lucid.scale n n ] $
|
||||
text_ [x_ "0", y_ "-12", font_size_ "24"
|
||||
, text_anchor_ "middle"
|
||||
, fill_ "white"] txt
|
||||
|
||||
drawHeart = proc () -> do
|
||||
emit -<
|
||||
g_ [transform_ $ translate (-170) (-260)] $
|
||||
g_ [transform_ $ rotateAround 225 150 121 <> " " <> scale 0.4 0.4] $
|
||||
g_ [transform_ $ Lucid.translate (-170) (-260)] $
|
||||
g_ [transform_ $ Lucid.rotateAround 225 150 121 <> " " <> Lucid.scale 0.4 0.4] $
|
||||
path_ ([stroke_ "red", fill_"red", d_ dat])
|
||||
dat = "M0 200 v-200 h200 a100,100 90 0,1 0,200 a100,100 90 0,1 -200,0 z"
|
||||
hex n = if n < 0x10 then "0" ++ showHex (round n) ""
|
||||
|
|
@ -318,14 +326,14 @@ frequencies = proc () -> do
|
|||
duration 3 -< ()
|
||||
n <- signal 0 1 -< ()
|
||||
emit -< do
|
||||
g_ [transform_ $ translate margin height] $ renderPath $ morphPath line1 (wave1 move) n
|
||||
g_ [transform_ $ Lucid.translate margin height] $ renderPath $ morphPath line1 (wave1 move) n
|
||||
let circleY = sum [ sin ((1+move)*pi*2*freq) * 20 | freq <- freqs ]
|
||||
circle_ [num_ cx_ (width+margin), num_ cy_ (height+circleY*n), num_ r_ 3, fill_ "red"]
|
||||
drawSecondWave = defineAnimation $ proc move -> do
|
||||
label "drawSecondWave" -< ()
|
||||
duration 3 -< ()
|
||||
emit -< do
|
||||
g_ [transform_ $ translate margin height] $ renderPath $ wave1 move
|
||||
g_ [transform_ $ Lucid.translate margin height] $ renderPath $ wave1 move
|
||||
let circleY = sum [ sin ((1+move)*pi*2*freq) * 20 | freq <- freqs ]
|
||||
circle_ [num_ cx_ (width+margin), num_ cy_ (height+circleY), num_ r_ 3, fill_ "red"]
|
||||
drawUpWave = defineAnimation $ proc move -> do
|
||||
|
|
@ -333,8 +341,8 @@ frequencies = proc () -> do
|
|||
duration 2 -< ()
|
||||
n <- signal 0 1 -< ()
|
||||
emit -< do
|
||||
g_ [transform_ $ scale 1 (1-0.5*n)] $ do
|
||||
g_ [transform_ $ translate margin height] $ renderPath $ wave1 move
|
||||
g_ [transform_ $ Lucid.scale 1 (1-0.5*n)] $ do
|
||||
g_ [transform_ $ Lucid.translate margin height] $ renderPath $ wave1 move
|
||||
let circleY = sum [ sin ((1+move)*pi*2*freq) * 20 | freq <- freqs ]
|
||||
circle_ [num_ cx_ (width+margin), num_ cy_ (height+circleY), num_ r_ 3, fill_ "red"]
|
||||
line1 = approxFnData 1000 $ \idx ->
|
||||
|
|
@ -349,7 +357,7 @@ latex_basic = proc () -> do
|
|||
s <- signalOscillate 0 1 -< ()
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
emit -<
|
||||
g_ [transform_ $ translate 20 15 <> " " <> scale 4 4] $ do
|
||||
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
|
||||
where
|
||||
|
|
@ -422,7 +430,7 @@ latex_draw = pauseAtEnd 1 $ defineAnimation $ proc () -> do
|
|||
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 = g_ [transform_ $ Lucid.translate 20 15 <> " " <> Lucid.scale 5 5]
|
||||
fillText txt = defineAnimation $ proc () -> do
|
||||
duration 1 -< ()
|
||||
s <- signal 0 1 -< ()
|
||||
|
|
@ -435,3 +443,49 @@ latex_draw = pauseAtEnd 1 $ defineAnimation $ proc () -> do
|
|||
emit -< placement $
|
||||
g_ [stroke_ "white", fill_opacity_ "0", stroke_width_ "0.1"] $
|
||||
toHtml $ partialSvg s $ latexAlign txt
|
||||
|
||||
|
||||
bbox :: Ani ()
|
||||
bbox = proc () -> do
|
||||
emit -< rect_ [width_ "100%", height_ "100%", fill_ "black"]
|
||||
annotate' bbox1 -< g_ [transform_ $ Lucid.translate (320/2-50) (180/2)]
|
||||
annotate' bbox2 -< g_ [transform_ $ Lucid.translate (320/2+50) (180/2)]
|
||||
|
||||
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", stroke_width_ "1"]
|
||||
g_ [fill_ "white"] $ toHtml rotated
|
||||
where
|
||||
msg = "\\sum_{k=1}^\\infty"
|
||||
svg = scale 3 $ center $ latexAlign msg
|
||||
|
||||
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", stroke_width_ "1"]
|
||||
g_ [fill_ "white", fill_opacity_ "0", stroke_width_ "4", stroke_ "white"] $
|
||||
toHtml rotated
|
||||
|
||||
heartShape =
|
||||
scale 0.15 $ 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.EndPath]
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@ import Graphics.Svg
|
|||
import Linear.Metric
|
||||
import Linear.V2
|
||||
import Linear.Vector
|
||||
import qualified Reanimate.Transform as Transform
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
|
|
@ -101,10 +102,10 @@ adjustLineLength alpha from cmd =
|
|||
|
||||
lineLength :: LineCommand -> CmdM Double
|
||||
lineLength cmd =
|
||||
case cmd of
|
||||
LineMove to -> pure 0 <* put to
|
||||
LineDraw to -> gets (distance to) <* put to
|
||||
LineBezier points -> gets (distance (last points)) <* put (last points)
|
||||
case cmd of
|
||||
LineMove to -> pure 0 <* put to
|
||||
LineDraw to -> gets (distance to) <* put to
|
||||
LineBezier points -> gets (distance (last points)) <* put (last points)
|
||||
|
||||
toLineCommands :: [PathCommand] -> [LineCommand]
|
||||
toLineCommands ps = evalState (worker zero Nothing ps) zero
|
||||
|
|
@ -161,7 +162,10 @@ toLineCommand startPos mbPrevControlPt cmd = do
|
|||
from <- get <* adjustPosition o to
|
||||
let c1 = maybe from (mirrorPoint from) mbControl
|
||||
pure $ LineBezier [c1,makeAbsolute o from to]
|
||||
EllipticalArc origin points -> undefined
|
||||
EllipticalArc o points -> concat <$>
|
||||
(forM points $ \(rotX, rotY, angle, largeArc, sweepFlag, to) -> do
|
||||
from <- get <* adjustPosition o to
|
||||
return $ convertSvgArc from rotX rotY angle largeArc sweepFlag (makeAbsolute o from to))
|
||||
EndPath -> put startPos *> pure [LineDraw startPos]
|
||||
where
|
||||
mirrorPoint c p = c*2-p
|
||||
|
|
@ -171,6 +175,82 @@ toLineCommand startPos mbPrevControlPt cmd = do
|
|||
makeAbsolute OriginRelative from p = from+p
|
||||
|
||||
|
||||
calculateVectorAngle :: Double -> Double -> Double -> Double -> Double
|
||||
calculateVectorAngle ux uy vx vy
|
||||
| tb >= ta
|
||||
= tb - ta
|
||||
| otherwise
|
||||
= pi * 2 - (ta - tb)
|
||||
where
|
||||
ta = atan2 uy ux
|
||||
tb = atan2 vy vx
|
||||
|
||||
-- ported from: https://github.com/vvvv/SVG/blob/master/Source/Paths/SvgArcSegment.cs
|
||||
convertSvgArc :: RPoint -> Coord -> Coord -> Coord -> Bool -> Bool -> RPoint -> [LineCommand]
|
||||
convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)
|
||||
| x0 == x && y0 == y
|
||||
= []
|
||||
| radiusX == 0.0 && radiusY == 0.0
|
||||
= [LineDraw (V2 x y)]
|
||||
| otherwise
|
||||
= calcSegments x0 y0 theta1' segments'
|
||||
where
|
||||
sinPhi = sin (angle * pi/180)
|
||||
cosPhi = cos (angle * pi/180)
|
||||
|
||||
x1dash = cosPhi * (x0 - x) / 2.0 + sinPhi * (y0 - y) / 2.0
|
||||
y1dash = -sinPhi * (x0 - x) / 2.0 + cosPhi * (y0 - y) / 2.0
|
||||
|
||||
numerator = radiusX * radiusX * radiusY * radiusY - radiusX * radiusX * y1dash * y1dash - radiusY * radiusY * x1dash * x1dash
|
||||
|
||||
s = sqrt(1.0 - numerator / (radiusX * radiusX * radiusY * radiusY))
|
||||
rx = if (numerator < 0.0) then (radiusX * s) else radiusX
|
||||
ry = if (numerator < 0.0) then (radiusY * s) else radiusY
|
||||
root = if (numerator < 0.0)
|
||||
then (0.0)
|
||||
else ((if ((largeArcFlag && sweepFlag) || (not largeArcFlag && not sweepFlag)) then (-1.0) else 1.0) *
|
||||
sqrt(numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash)))
|
||||
|
||||
cxdash = root * rx * y1dash / ry
|
||||
cydash = -root * ry * x1dash / rx
|
||||
|
||||
cx = cosPhi * cxdash - sinPhi * cydash + (x0 + x) / 2.0
|
||||
cy = sinPhi * cxdash + cosPhi * cydash + (y0 + y) / 2.0
|
||||
|
||||
theta1' = calculateVectorAngle 1.0 0.0 ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry)
|
||||
dtheta' = calculateVectorAngle ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry) ((-x1dash - cxdash) / rx) ((-y1dash - cydash) / ry)
|
||||
dtheta = if (not sweepFlag && dtheta' > 0)
|
||||
then (dtheta' - 2 * pi)
|
||||
else (if (sweepFlag && dtheta' < 0) then (dtheta' + 2 * pi) else dtheta')
|
||||
|
||||
segments' = ceiling (abs (dtheta / (pi / 2.0)))
|
||||
delta = dtheta / fromInteger segments'
|
||||
t = 8.0 / 3.0 * sin(delta / 4.0) * sin(delta / 4.0) / sin(delta / 2.0)
|
||||
|
||||
calcSegments startX startY theta1 segments
|
||||
| segments == 0
|
||||
= []
|
||||
| otherwise
|
||||
= LineBezier [ V2 (startX + dx1) (startY + dy1)
|
||||
, V2 (endpointX + dxe) (endpointY + dye)
|
||||
, V2 endpointX endpointY ] : calcSegments endpointX endpointY theta2 (segments - 1)
|
||||
where
|
||||
cosTheta1 = cos theta1
|
||||
sinTheta1 = sin theta1
|
||||
theta2 = theta1 + delta
|
||||
cosTheta2 = cos theta2
|
||||
sinTheta2 = sin theta2
|
||||
|
||||
endpointX = cosPhi * rx * cosTheta2 - sinPhi * ry * sinTheta2 + cx
|
||||
endpointY = sinPhi * rx * cosTheta2 + cosPhi * ry * sinTheta2 + cy
|
||||
|
||||
dx1 = t * (-cosPhi * rx * sinTheta1 - sinPhi * ry * cosTheta1)
|
||||
dy1 = t * (-sinPhi * rx * sinTheta1 + cosPhi * ry * cosTheta1)
|
||||
|
||||
dxe = t * (cosPhi * rx * sinTheta2 + sinPhi * ry * cosTheta2)
|
||||
dye = t * (sinPhi * rx * sinTheta2 - cosPhi * ry * cosTheta2)
|
||||
|
||||
|
||||
-- Algorithm taken from manim. It's magic.
|
||||
bezier :: [RPoint] -> Double -> RPoint
|
||||
bezier points t = sum
|
||||
|
|
@ -179,6 +259,8 @@ bezier points t = sum
|
|||
where
|
||||
n = length points -1
|
||||
choose n k = product [n,n-1 .. n-k+1] `div` product [1..k]
|
||||
|
||||
partial_bezier_points :: [RPoint] -> Double -> Double -> [RPoint]
|
||||
partial_bezier_points points a b
|
||||
| isNaN end_prop || isInfinite end_prop = replicate (length points) (last points)
|
||||
| otherwise = [ bezier (take (i+1) a_to_1) end_prop | i <- [0..length points-1] ]
|
||||
|
|
@ -190,78 +272,6 @@ partial_bezier_points points a b
|
|||
|
||||
interpolatePathCommands :: Double -> [PathCommand] -> [PathCommand]
|
||||
interpolatePathCommands alpha = lineToPath . partialLine alpha . toLineCommands
|
||||
-- evalState (worker 0 cmds) zero
|
||||
-- where
|
||||
-- worker d [] = pure []
|
||||
-- worker d (x:xs) | d > minDistance = pure []
|
||||
-- worker d (LineTo OriginAbsolute []:xs) = worker d xs
|
||||
-- worker d (LineTo OriginAbsolute (to:tos):xs) = do
|
||||
-- from <- get <* put to
|
||||
-- let d' = distance from to
|
||||
-- out = LineTo OriginAbsolute [lerp (min 1 ((minDistance-d)/d')) to from]
|
||||
-- rest = LineTo OriginAbsolute tos
|
||||
-- (out:) <$> worker (d+d') (rest:xs)
|
||||
-- worker d (LineTo OriginRelative []:xs) = worker d xs
|
||||
-- worker d (LineTo OriginRelative (to:tos):xs) = do
|
||||
-- from <- get <* modify (+to)
|
||||
-- let d' = distance zero to
|
||||
-- out = LineTo OriginRelative [lerp (min 1 ((minDistance-d)/d')) to zero]
|
||||
-- rest = LineTo OriginRelative tos
|
||||
-- (out:) <$> worker (d+d') (rest:xs)
|
||||
-- worker d (x:xs) = do
|
||||
-- d' <- estimateCmdLength x
|
||||
-- (x:) <$> worker (d+d') xs
|
||||
-- minDistance = estimatePathLength cmds * alpha
|
||||
--
|
||||
-- splitPathCommands :: [PathCommand] -> [PathCommand]
|
||||
-- splitPathCommands cmds = evalState (concat <$> mapM splitPathCommand cmds) zero
|
||||
--
|
||||
-- splitPathCommand :: PathCommand -> CmdM [PathCommand]
|
||||
-- splitPathCommand cmd = do
|
||||
-- case cmd of
|
||||
-- MoveTo OriginAbsolute [] -> pure [cmd]
|
||||
-- MoveTo OriginAbsolute lst -> put (last lst) *> pure [cmd]
|
||||
-- MoveTo OriginRelative lst -> modify (+ sum lst) *> pure [cmd]
|
||||
-- -- LineTo OriginAbsolute lst -> do
|
||||
-- -- concat <$> forM lst (\to -> do
|
||||
-- -- from <- get <* put (to :: RPoint)
|
||||
-- -- let towardsTo = (to - from) / fromIntegral pieces :: RPoint
|
||||
-- -- return $ replicate pieces (LineTo OriginRelative [towardsTo]))
|
||||
-- -- LineTo OriginRelative lst -> do
|
||||
-- -- concat <$> forM lst (\to -> do
|
||||
-- -- from <- get <* modify (+to)
|
||||
-- -- let towardsTo = to / fromIntegral pieces :: RPoint
|
||||
-- -- return $ replicate pieces (LineTo OriginRelative [towardsTo]))
|
||||
-- _ -> pure [cmd]
|
||||
-- where
|
||||
-- pieces = 100 :: Int
|
||||
--
|
||||
-- estimatePathLength :: [PathCommand] -> Double
|
||||
-- estimatePathLength cmds = evalState (sum <$> mapM estimateCmdLength cmds) zero
|
||||
--
|
||||
-- estimateCmdLength :: PathCommand -> CmdM Double
|
||||
-- estimateCmdLength cmd =
|
||||
-- case cmd of
|
||||
-- MoveTo OriginAbsolute [] -> pure 0
|
||||
-- MoveTo OriginAbsolute lst -> put (last lst) *> pure 0
|
||||
-- MoveTo OriginRelative lst -> modify (+ sum lst) *> pure 0
|
||||
-- LineTo OriginAbsolute lst ->
|
||||
-- sum <$> forM lst (\to -> gets (distance to) <* put to)
|
||||
-- LineTo OriginRelative lst ->
|
||||
-- sum <$> forM lst (\to -> modify (+to) *> pure (distance zero to))
|
||||
-- HorizontalTo OriginAbsolute lst -> undefined
|
||||
-- HorizontalTo OriginRelative lst -> undefined
|
||||
-- VerticalTo OriginAbsolute lst -> undefined
|
||||
-- VerticalTo OriginRelative lst -> undefined
|
||||
-- CurveTo origin quads -> undefined
|
||||
-- SmoothCurveTo origin lst -> undefined
|
||||
-- QuadraticBezier origin pairs -> undefined
|
||||
-- SmoothQuadraticBezierCurveTo origin points -> undefined
|
||||
-- EllipticalArc origin points -> undefined
|
||||
-- EndPath -> pure 0
|
||||
|
||||
-- lineToPath :: [LineCommand] -> [PathCommand]
|
||||
-- partialLine :: Double -> [LineCommand] -> [LineCommand]
|
||||
|
||||
partialSvg :: Double -> Tree -> Tree
|
||||
partialSvg alpha = mapTree worker
|
||||
|
|
@ -269,3 +279,74 @@ partialSvg alpha = mapTree worker
|
|||
worker (PathTree path) =
|
||||
PathTree $ path & pathDefinition %~ lineToPath . partialLine alpha . toLineCommands
|
||||
worker t = t
|
||||
|
||||
-- (x,y,w,h)
|
||||
boundingBox :: Tree -> (Double, Double, Double, Double)
|
||||
boundingBox t =
|
||||
case svgBoundingPoints t of
|
||||
[] -> (0,0,0,0)
|
||||
(V2 x y:rest) ->
|
||||
let (minx, miny, maxx, maxy) = foldl' worker (x, y, x, y) rest
|
||||
in (minx, miny, maxx-minx, maxy-miny)
|
||||
where
|
||||
worker (minx, miny, maxx, maxy) (V2 x y) =
|
||||
(min minx x, min miny y, max maxx x, max maxy y)
|
||||
|
||||
linePoints :: [LineCommand] -> [RPoint]
|
||||
linePoints = worker zero
|
||||
where
|
||||
worker from [] = []
|
||||
worker from (x:xs) =
|
||||
case x of
|
||||
LineMove to -> worker to xs
|
||||
LineDraw to -> from:to:worker to xs
|
||||
LineBezier ctrl -> -- approximation
|
||||
[ last (partial_bezier_points (from:ctrl) 0 (recip chunks*i)) | i <- [0..chunks]] ++
|
||||
worker (last ctrl) xs
|
||||
chunks = 10
|
||||
|
||||
svgBoundingPoints :: Tree -> [RPoint]
|
||||
svgBoundingPoints t = map (Transform.transformPoint m) $
|
||||
case t of
|
||||
None -> []
|
||||
UseTree{} -> []
|
||||
GroupTree g -> concatMap svgBoundingPoints (g^.groupChildren)
|
||||
SymbolTree (Symbol g) -> concatMap svgBoundingPoints (g^.groupChildren)
|
||||
PathTree p -> linePoints $ toLineCommands (p^.pathDefinition)
|
||||
CircleTree{} -> error "CircleTree"
|
||||
PolyLineTree{} -> error "PolyLineTree"
|
||||
EllipseTree{} -> error "EllipseTree"
|
||||
LineTree{} -> error "LineTree"
|
||||
RectangleTree{} -> error "RectangleTree"
|
||||
TextTree{} -> []
|
||||
ImageTree{} -> []
|
||||
MeshGradientTree{} -> []
|
||||
where
|
||||
m = Transform.mkMatrix (t^.drawAttr.transform)
|
||||
|
||||
withTransformations :: [Transformation] -> Tree -> Tree
|
||||
withTransformations transformations tree = GroupTree $ defaultSvg
|
||||
& drawAttr .~ attr
|
||||
& groupChildren .~ [tree]
|
||||
where
|
||||
attr = defaultSvg & transform .~ Just transformations
|
||||
|
||||
translate :: Double -> Double -> Tree -> Tree
|
||||
translate x y = withTransformations [Translate x y]
|
||||
|
||||
rotate :: Double -> Tree -> Tree
|
||||
rotate a = withTransformations [Rotate a Nothing]
|
||||
|
||||
rotateAround :: Double -> RPoint -> Tree -> Tree
|
||||
rotateAround a (V2 x y) = withTransformations [Rotate a (Just (x,y))]
|
||||
|
||||
scale :: Double -> Tree -> Tree
|
||||
scale a = withTransformations [Scale a Nothing]
|
||||
|
||||
scaleXY :: Double -> Double -> Tree -> Tree
|
||||
scaleXY x y = withTransformations [Scale x (Just y)]
|
||||
|
||||
center :: Tree -> Tree
|
||||
center t = translate (-x-w/2) (-y-h/2) t
|
||||
where
|
||||
(x, y, w, h) = boundingBox t
|
||||
|
|
|
|||
47
src/Reanimate/Transform.hs
Normal file
47
src/Reanimate/Transform.hs
Normal file
|
|
@ -0,0 +1,47 @@
|
|||
module Reanimate.Transform
|
||||
( identity
|
||||
, transformPoint
|
||||
, mkMatrix
|
||||
) where
|
||||
|
||||
-- XXX: Use Linear.Matrix instead of Data.Matrix to drop the 'matrix' dependency.
|
||||
import Data.List
|
||||
import Data.Matrix (Matrix)
|
||||
import qualified Data.Matrix as M
|
||||
import Data.Maybe
|
||||
import Graphics.Svg
|
||||
import Linear.V2
|
||||
|
||||
type TMatrix = Matrix Coord
|
||||
|
||||
identity :: TMatrix
|
||||
identity = M.identity 3
|
||||
|
||||
fromList :: [Coord] -> TMatrix
|
||||
fromList [a,b,c,d,e,f] = M.fromList 3 3 [a,c,e,b,d,f,0,0,1]
|
||||
fromList _ = error "Reanimate.Transform.fromList: bad input"
|
||||
|
||||
transformPoint :: TMatrix -> RPoint -> RPoint
|
||||
transformPoint m (V2 x y) = V2 (a*x +c*y + e) (b*x + d*y +f)
|
||||
where
|
||||
(a:c:e:b:d:f:_) = M.toList m
|
||||
|
||||
mkMatrix :: Maybe [Transformation] -> TMatrix
|
||||
mkMatrix Nothing = identity
|
||||
mkMatrix (Just ts) = foldl' (*) identity (map transformationMatrix ts)
|
||||
|
||||
transformationMatrix :: Transformation -> TMatrix
|
||||
transformationMatrix transformation =
|
||||
case transformation of
|
||||
TransformMatrix a b c d e f -> fromList [a,b,c,d,e,f]
|
||||
Translate x y -> translate x y
|
||||
Scale sx mbSy -> fromList [sx,0,0,fromMaybe sx mbSy,0,0]
|
||||
Rotate a Nothing -> rotate a
|
||||
Rotate a (Just (x,y)) -> translate x y * rotate a * translate (-x) (-y)
|
||||
SkewX a -> fromList [1,0,tan (a*pi/180),1,0,0]
|
||||
SkewY a -> fromList [1,tan (a*pi/180),0,1,0,0]
|
||||
TransformUnknown -> identity
|
||||
where
|
||||
translate x y = fromList [1,0,0,1,x,y]
|
||||
rotate a = fromList [cos r,sin r,-sin r,cos r,0,0]
|
||||
where r = a * pi / 180
|
||||
Loading…
Reference in a new issue