hashirama/reanimate
Watch
1
0
Fork
You've already forked reanimate
 0
mirror of https://github.com/reanimate/reanimate.git synced 2026-09-14 09:32:22 +00:00
Code Issues Projects Releases Wiki Activity
reanimate/reanimate-0.4.1.0-inplace/Reanimate.Svg.LineCommand.hs.html

284 lines
35 KiB
HTML
Raw Blame History

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<style type="text/css">
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
span.nottickedoff { background: yellow}
span.istickedoff { background: white }
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
span.decl { font-weight: bold }
span.spaces { background: white }
</style>
</head>
<body>
<pre>
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
</pre>
<pre>
<span class="lineno"> 1 </span>module Reanimate.Svg.LineCommand where
<span class="lineno"> 2 </span>
<span class="lineno"> 3 </span>import Control.Lens ((%~), (&amp;), (.~))
<span class="lineno"> 4 </span>import Control.Monad.Fix
<span class="lineno"> 5 </span>import Control.Monad.State
<span class="lineno"> 6 </span>import Data.Functor
<span class="lineno"> 7 </span>import qualified Data.Vector.Unboxed as V
<span class="lineno"> 8 </span>import qualified Reanimate.Internal.CubicBezier as Bezier
<span class="lineno"> 9 </span>import Graphics.SvgTree hiding (height, line, path, use, width)
<span class="lineno"> 10 </span>import Linear.Metric
<span class="lineno"> 11 </span>import Linear.V2 hiding (angle)
<span class="lineno"> 12 </span>import Linear.Vector
<span class="lineno"> 13 </span>
<span class="lineno"> 14 </span>type CmdM a = State RPoint a
<span class="lineno"> 15 </span>
<span class="lineno"> 16 </span>data LineCommand
<span class="lineno"> 17 </span> = LineMove RPoint
<span class="lineno"> 18 </span> -- | LineDraw RPoint
<span class="lineno"> 19 </span> | LineBezier [RPoint]
<span class="lineno"> 20 </span> | LineEnd RPoint
<span class="lineno"> 21 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>)
<span class="lineno"> 22 </span>
<span class="lineno"> 23 </span>lineToPath :: [LineCommand] -&gt; [PathCommand]
<span class="lineno"> 24 </span><span class="decl"><span class="istickedoff">lineToPath = map worker</span>
<span class="lineno"> 25 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 26 </span><span class="spaces"> </span><span class="istickedoff">worker (LineMove p) = MoveTo OriginAbsolute [p]</span>
<span class="lineno"> 27 </span><span class="spaces"> </span><span class="istickedoff">-- worker (LineDraw p) = LineTo OriginAbsolute [p]</span>
<span class="lineno"> 28 </span><span class="spaces"> </span><span class="istickedoff">worker (LineBezier [a,b,c]) = CurveTo OriginAbsolute [(a,b,c)]</span>
<span class="lineno"> 29 </span><span class="spaces"> </span><span class="istickedoff">worker (LineBezier [a,b]) = QuadraticBezier OriginAbsolute [(a,b)]</span>
<span class="lineno"> 30 </span><span class="spaces"> </span><span class="istickedoff">worker (LineBezier [a]) = LineTo OriginAbsolute [a]</span>
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="istickedoff">worker LineBezier{} = <span class="nottickedoff">error &quot;Reanimate.Svg.lineToPath: invalid bezier curve&quot;</span></span>
<span class="lineno"> 32 </span><span class="spaces"> </span><span class="istickedoff">worker LineEnd{} = EndPath</span></span>
<span class="lineno"> 33 </span>
<span class="lineno"> 34 </span>lineToPoints :: Int -&gt; [LineCommand] -&gt; [RPoint]
<span class="lineno"> 35 </span><span class="decl"><span class="nottickedoff">lineToPoints nPoints cmds =</span>
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="nottickedoff">map lineEnd lineSegments</span>
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="nottickedoff">lineSegments = [ partialLine (fromIntegral n/ fromIntegral nPoints) cmds | n &lt;- [0 .. nPoints-1] ]</span>
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="nottickedoff">lineEnd [LineBezier pts] = last pts</span>
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="nottickedoff">lineEnd (_:xs) = lineEnd xs</span>
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="nottickedoff">lineEnd _ = error &quot;invalid line&quot;</span></span>
<span class="lineno"> 42 </span>
<span class="lineno"> 43 </span>partialLine :: Double -&gt; [LineCommand] -&gt; [LineCommand]
<span class="lineno"> 44 </span><span class="decl"><span class="istickedoff">partialLine alpha cmds = evalState (worker 0 cmds) <span class="nottickedoff">zero</span></span>
<span class="lineno"> 45 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="istickedoff">worker _d [] = <span class="nottickedoff">pure []</span></span>
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="istickedoff">worker d (cmd:xs) = do</span>
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="istickedoff">from &lt;- get</span>
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="istickedoff">len &lt;- lineLength cmd</span>
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="istickedoff">let frac = (targetLen-d) / len</span>
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="istickedoff">if len == 0 || frac &gt;= 1</span>
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="istickedoff">then (cmd:) &lt;$&gt; worker (d+len) xs</span>
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="istickedoff">else pure [adjustLineLength frac from cmd]</span>
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="istickedoff">totalLen = evalState (sum &lt;$&gt; mapM lineLength cmds) <span class="nottickedoff">zero</span></span>
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="istickedoff">targetLen = totalLen * alpha</span></span>
<span class="lineno"> 56 </span>
<span class="lineno"> 57 </span>adjustLineLength :: Double -&gt; RPoint -&gt; LineCommand -&gt; LineCommand
<span class="lineno"> 58 </span><span class="decl"><span class="istickedoff">adjustLineLength alpha from cmd =</span>
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="istickedoff">case cmd of</span>
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="istickedoff">LineBezier points -&gt; LineBezier $ drop 1 $ partialBezierPoints (from:points) 0 alpha</span>
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="istickedoff">LineMove p -&gt; <span class="nottickedoff">LineMove p</span></span>
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="istickedoff">-- LineDraw t -&gt; LineDraw (lerp alpha t from)</span>
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="istickedoff">LineEnd p -&gt; LineBezier [lerp alpha p from]</span></span>
<span class="lineno"> 64 </span>
<span class="lineno"> 65 </span>lineLength :: LineCommand -&gt; CmdM Double
<span class="lineno"> 66 </span><span class="decl"><span class="istickedoff">lineLength cmd =</span>
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="istickedoff">case cmd of</span>
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="istickedoff">LineMove to -&gt; 0 &lt;$ put to</span>
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="istickedoff">-- Straight line:</span>
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="istickedoff">LineBezier [dst] -&gt; gets (distance dst) &lt;* put dst</span>
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="istickedoff">-- Some kind of curve:</span>
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="istickedoff">LineBezier lst -&gt; do</span>
<span class="lineno"> 73 </span><span class="spaces"> </span><span class="istickedoff">from &lt;- get</span>
<span class="lineno"> 74 </span><span class="spaces"> </span><span class="istickedoff">let bezier = rpointsToBezier (from:lst)</span>
<span class="lineno"> 75 </span><span class="spaces"> </span><span class="istickedoff">tol = 0.0001</span>
<span class="lineno"> 76 </span><span class="spaces"> </span><span class="istickedoff">put (last lst)</span>
<span class="lineno"> 77 </span><span class="spaces"> </span><span class="istickedoff">pure $ Bezier.arcLength bezier 1 tol</span>
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="istickedoff">LineEnd to -&gt; gets (distance to) &lt;* <span class="nottickedoff">put to</span></span></span>
<span class="lineno"> 79 </span>
<span class="lineno"> 80 </span>rpointsToBezier :: [RPoint] -&gt; Bezier.CubicBezier Double
<span class="lineno"> 81 </span><span class="decl"><span class="istickedoff">rpointsToBezier lst =</span>
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="istickedoff">case lst of</span>
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="istickedoff">[a,b] -&gt; <span class="nottickedoff">Bezier.CubicBezier a a b b</span></span>
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="istickedoff">[a,b,c] -&gt; <span class="nottickedoff">Bezier.quadToCubic (Bezier.QuadBezier a b c)</span></span>
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="istickedoff">[a,b,c,d] -&gt; Bezier.CubicBezier a b c d</span>
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="istickedoff">_ -&gt; <span class="nottickedoff">error $ &quot;rpointsToBezier: Invalid list of points: &quot; ++ show lst</span></span></span>
<span class="lineno"> 87 </span>
<span class="lineno"> 88 </span>toLineCommands :: [PathCommand] -&gt; [LineCommand]
<span class="lineno"> 89 </span><span class="decl"><span class="istickedoff">toLineCommands ps = evalState (worker <span class="nottickedoff">zero</span> <span class="nottickedoff">Nothing</span> ps) <span class="nottickedoff">zero</span></span>
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="istickedoff">worker _startPos _mbPrevControlPt [] = pure []</span>
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="istickedoff">worker startPos mbPrevControlPt (cmd:cmds) = do</span>
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="istickedoff">lcmds &lt;- toLineCommand startPos <span class="nottickedoff">mbPrevControlPt</span> cmd</span>
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="istickedoff">let startPos' =</span>
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="istickedoff">case lcmds of</span>
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="istickedoff">[LineMove pos] -&gt; pos</span>
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="istickedoff">_ -&gt; startPos</span>
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="istickedoff">(lcmds++) &lt;$&gt; worker startPos' <span class="nottickedoff">(cmdToControlPoint $ last lcmds)</span> cmds</span></span>
<span class="lineno"> 99 </span>
<span class="lineno"> 100 </span>cmdToControlPoint :: LineCommand -&gt; Maybe RPoint
<span class="lineno"> 101 </span><span class="decl"><span class="nottickedoff">cmdToControlPoint (LineBezier points) = Just (last (init points))</span>
<span class="lineno"> 102 </span><span class="spaces"></span><span class="nottickedoff">cmdToControlPoint _ = Nothing</span></span>
<span class="lineno"> 103 </span>
<span class="lineno"> 104 </span>mkStraightLine :: RPoint -&gt; LineCommand
<span class="lineno"> 105 </span><span class="decl"><span class="istickedoff">mkStraightLine p = LineBezier [p]</span></span>
<span class="lineno"> 106 </span>
<span class="lineno"> 107 </span>toLineCommand :: RPoint -&gt; Maybe RPoint -&gt; PathCommand -&gt; CmdM [LineCommand]
<span class="lineno"> 108 </span><span class="decl"><span class="istickedoff">toLineCommand startPos mbPrevControlPt cmd =</span>
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="istickedoff">case cmd of</span>
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="istickedoff">MoveTo OriginAbsolute [] -&gt; <span class="nottickedoff">pure []</span></span>
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="istickedoff">MoveTo OriginAbsolute lst -&gt; put (last lst) *&gt; gets (pure.LineMove)</span>
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="istickedoff">MoveTo OriginRelative lst -&gt; <span class="nottickedoff">modify (+ sum lst) *&gt; gets (pure.LineMove)</span></span>
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="istickedoff">LineTo OriginAbsolute lst -&gt; forM lst (\to -&gt; <span class="nottickedoff">put to</span> $&gt; mkStraightLine to)</span>
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="istickedoff">LineTo OriginRelative lst -&gt; <span class="nottickedoff">forM lst (\to -&gt; modify (+to) *&gt; gets mkStraightLine)</span></span>
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="istickedoff">HorizontalTo OriginAbsolute lst -&gt;</span>
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">forM lst $ \x -&gt; modify (_x .~ x) *&gt; gets mkStraightLine</span></span>
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff">HorizontalTo OriginRelative lst -&gt;</span>
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="istickedoff">forM lst $ \x -&gt; modify (_x %~ (+x)) *&gt; gets mkStraightLine</span>
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="istickedoff">VerticalTo OriginAbsolute lst -&gt;</span>
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">forM lst $ \y -&gt; modify (_y .~ y) *&gt; gets mkStraightLine</span></span>
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="istickedoff">VerticalTo OriginRelative lst -&gt;</span>
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="istickedoff">forM lst $ \y -&gt; modify (_y %~ (+y)) *&gt; gets mkStraightLine</span>
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="istickedoff">CurveTo OriginAbsolute quads -&gt;</span>
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">forM quads $ \(a,b,c) -&gt; put c $&gt; LineBezier [a,b,c]</span></span>
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="istickedoff">CurveTo OriginRelative quads -&gt;</span>
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">forM quads $ \(a,b,c) -&gt; do</span></span>
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">from &lt;- get &lt;* modify (+c)</span></span>
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pure $ LineBezier $ map (+from) [a,b,c]</span></span>
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="istickedoff">SmoothCurveTo o lst -&gt; <span class="nottickedoff">mfix $ \result -&gt; do</span></span>
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let ctrl = mbPrevControlPt : map cmdToControlPoint result</span></span>
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">forM (zip lst ctrl) $ \((c2,to), mbControl) -&gt; do</span></span>
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">from &lt;- get &lt;* adjustPosition o to</span></span>
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let c1 = maybe (makeAbsolute o from c2) (mirrorPoint from) mbControl</span></span>
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pure $ LineBezier [c1,makeAbsolute o from c2,makeAbsolute o from to]</span></span>
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="istickedoff">QuadraticBezier OriginAbsolute pairs -&gt;</span>
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="istickedoff">forM pairs $ \(a,b) -&gt; <span class="nottickedoff">put b</span> $&gt; LineBezier [a,b]</span>
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="istickedoff">QuadraticBezier OriginRelative pairs -&gt;</span>
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="istickedoff">forM pairs $ \(a,b) -&gt; do</span>
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="istickedoff">from &lt;- get &lt;* <span class="nottickedoff">modify (+b)</span></span>
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="istickedoff">pure $ LineBezier $ map (+from) [a,b]</span>
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="istickedoff">SmoothQuadraticBezierCurveTo o lst -&gt; <span class="nottickedoff">mfix $ \result -&gt; do</span></span>
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let ctrl = mbPrevControlPt : map cmdToControlPoint result</span></span>
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">forM (zip lst ctrl) $ \(to, mbControl) -&gt; do</span></span>
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">from &lt;- get &lt;* adjustPosition o to</span></span>
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let c1 = maybe from (mirrorPoint from) mbControl</span></span>
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pure $ LineBezier [c1,makeAbsolute o from to]</span></span>
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="istickedoff">EllipticalArc o points -&gt; concat &lt;$&gt;</span>
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="istickedoff">forM points (\(rotX, rotY, angle, largeArc, sweepFlag, to) -&gt; do</span>
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="istickedoff">from &lt;- get &lt;* adjustPosition o to</span>
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="istickedoff">return $ convertSvgArc from rotX rotY angle largeArc sweepFlag (makeAbsolute o from to))</span>
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="istickedoff">EndPath -&gt; <span class="nottickedoff">put startPos</span> $&gt; [LineEnd startPos]</span>
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">mirrorPoint c p = c*2-p</span></span>
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="istickedoff">adjustPosition OriginRelative p = modify (+p)</span>
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="istickedoff">adjustPosition OriginAbsolute p = <span class="nottickedoff">put p</span></span>
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="istickedoff">makeAbsolute OriginAbsolute _from p = <span class="nottickedoff">p</span></span>
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="istickedoff">makeAbsolute OriginRelative from p = from+p</span></span>
<span class="lineno"> 158 </span>
<span class="lineno"> 159 </span>
<span class="lineno"> 160 </span>calculateVectorAngle :: Double -&gt; Double -&gt; Double -&gt; Double -&gt; Double
<span class="lineno"> 161 </span><span class="decl"><span class="istickedoff">calculateVectorAngle ux uy vx vy</span>
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="istickedoff">| tb &gt;= ta</span>
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="istickedoff">= tb - ta</span>
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span></span>
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="istickedoff">= pi * 2 - (ta - tb)</span>
<span class="lineno"> 166 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="istickedoff">ta = atan2 uy ux</span>
<span class="lineno"> 168 </span><span class="spaces"> </span><span class="istickedoff">tb = atan2 vy vx</span></span>
<span class="lineno"> 169 </span>
<span class="lineno"> 170 </span>-- ported from: https://github.com/vvvv/SVG/blob/master/Source/Paths/SvgArcSegment.cs
<span class="lineno"> 171 </span>{- HLINT ignore convertSvgArc -}
<span class="lineno"> 172 </span>convertSvgArc :: RPoint -&gt; Coord -&gt; Coord -&gt; Coord -&gt; Bool -&gt; Bool -&gt; RPoint -&gt; [LineCommand]
<span class="lineno"> 173 </span><span class="decl"><span class="istickedoff">convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)</span>
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlyfalse">x0 == x &amp;&amp; <span class="nottickedoff">y0 == y</span></span></span>
<span class="lineno"> 175 </span><span class="spaces"> </span><span class="istickedoff">= <span class="nottickedoff">[]</span></span>
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlyfalse">radiusX == 0.0 &amp;&amp; <span class="nottickedoff">radiusY == 0.0</span></span></span>
<span class="lineno"> 177 </span><span class="spaces"> </span><span class="istickedoff">= <span class="nottickedoff">[LineBezier [V2 x y]]</span></span>
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span></span>
<span class="lineno"> 179 </span><span class="spaces"> </span><span class="istickedoff">= calcSegments x0 y0 theta1' segments'</span>
<span class="lineno"> 180 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="istickedoff">sinPhi = sin (angle * pi/180)</span>
<span class="lineno"> 182 </span><span class="spaces"> </span><span class="istickedoff">cosPhi = cos (angle * pi/180)</span>
<span class="lineno"> 183 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="istickedoff">x1dash = cosPhi * (x0 - x) / 2.0 + sinPhi * (y0 - y) / 2.0</span>
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="istickedoff">y1dash = -sinPhi * (x0 - x) / 2.0 + cosPhi * (y0 - y) / 2.0</span>
<span class="lineno"> 186 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="istickedoff">numerator = radiusX * radiusX * radiusY * radiusY - radiusX * radiusX * y1dash * y1dash - radiusY * radiusY * x1dash * x1dash</span>
<span class="lineno"> 188 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 189 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">s = sqrt(1.0 - numerator / (radiusX * radiusX * radiusY * radiusY))</span></span>
<span class="lineno"> 190 </span><span class="spaces"> </span><span class="istickedoff">rx = if <span class="tickonlyfalse">(numerator &lt; 0.0)</span> then <span class="nottickedoff">(radiusX * s)</span> else radiusX</span>
<span class="lineno"> 191 </span><span class="spaces"> </span><span class="istickedoff">ry = if <span class="tickonlyfalse">(numerator &lt; 0.0)</span> then <span class="nottickedoff">(radiusY * s)</span> else radiusY</span>
<span class="lineno"> 192 </span><span class="spaces"> </span><span class="istickedoff">root = if <span class="tickonlyfalse">(numerator &lt; 0.0)</span></span>
<span class="lineno"> 193 </span><span class="spaces"> </span><span class="istickedoff">then <span class="nottickedoff">(0.0)</span></span>
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="istickedoff">else ((if <span class="tickonlyfalse">((largeArcFlag &amp;&amp; sweepFlag) || (not largeArcFlag &amp;&amp; <span class="nottickedoff">not sweepFlag</span>))</span> then <span class="nottickedoff">(-1.0)</span> else 1.0) *</span>
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="istickedoff">sqrt(numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash)))</span>
<span class="lineno"> 196 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="istickedoff">cxdash = root * rx * y1dash / ry</span>
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="istickedoff">cydash = -root * ry * x1dash / rx</span>
<span class="lineno"> 199 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="istickedoff">cx = cosPhi * cxdash - sinPhi * cydash + (x0 + x) / 2.0</span>
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="istickedoff">cy = sinPhi * cxdash + cosPhi * cydash + (y0 + y) / 2.0</span>
<span class="lineno"> 202 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="istickedoff">theta1' = calculateVectorAngle 1.0 0.0 ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry)</span>
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="istickedoff">dtheta' = calculateVectorAngle ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry) ((-x1dash - cxdash) / rx) ((-y1dash - cydash) / ry)</span>
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="istickedoff">dtheta = if <span class="tickonlytrue">(not sweepFlag &amp;&amp; dtheta' &gt; 0)</span></span>
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="istickedoff">then (dtheta' - 2 * pi)</span>
<span class="lineno"> 207 </span><span class="spaces"> </span><span class="istickedoff">else <span class="nottickedoff">(if (sweepFlag &amp;&amp; dtheta' &lt; 0) then dtheta' + 2 * pi else dtheta')</span></span>
<span class="lineno"> 208 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 209 </span><span class="spaces"> </span><span class="istickedoff">segments' = ceiling (abs (dtheta / (pi / 2.0)))</span>
<span class="lineno"> 210 </span><span class="spaces"> </span><span class="istickedoff">delta = dtheta / fromInteger segments'</span>
<span class="lineno"> 211 </span><span class="spaces"> </span><span class="istickedoff">t = 8.0 / 3.0 * sin(delta / 4.0) * sin(delta / 4.0) / sin(delta / 2.0)</span>
<span class="lineno"> 212 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 213 </span><span class="spaces"> </span><span class="istickedoff">calcSegments startX startY theta1 segments</span>
<span class="lineno"> 214 </span><span class="spaces"> </span><span class="istickedoff">| segments == 0</span>
<span class="lineno"> 215 </span><span class="spaces"> </span><span class="istickedoff">= []</span>
<span class="lineno"> 216 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span></span>
<span class="lineno"> 217 </span><span class="spaces"> </span><span class="istickedoff">= LineBezier [ V2 (startX + dx1) (startY + dy1)</span>
<span class="lineno"> 218 </span><span class="spaces"> </span><span class="istickedoff">, V2 (endpointX + dxe) (endpointY + dye)</span>
<span class="lineno"> 219 </span><span class="spaces"> </span><span class="istickedoff">, V2 endpointX endpointY ] : calcSegments endpointX endpointY theta2 (segments - 1)</span>
<span class="lineno"> 220 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 221 </span><span class="spaces"> </span><span class="istickedoff">cosTheta1 = cos theta1</span>
<span class="lineno"> 222 </span><span class="spaces"> </span><span class="istickedoff">sinTheta1 = sin theta1</span>
<span class="lineno"> 223 </span><span class="spaces"> </span><span class="istickedoff">theta2 = theta1 + delta</span>
<span class="lineno"> 224 </span><span class="spaces"> </span><span class="istickedoff">cosTheta2 = cos theta2</span>
<span class="lineno"> 225 </span><span class="spaces"> </span><span class="istickedoff">sinTheta2 = sin theta2</span>
<span class="lineno"> 226 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 227 </span><span class="spaces"> </span><span class="istickedoff">endpointX = cosPhi * rx * cosTheta2 - sinPhi * ry * sinTheta2 + cx</span>
<span class="lineno"> 228 </span><span class="spaces"> </span><span class="istickedoff">endpointY = sinPhi * rx * cosTheta2 + cosPhi * ry * sinTheta2 + cy</span>
<span class="lineno"> 229 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 230 </span><span class="spaces"> </span><span class="istickedoff">dx1 = t * (-cosPhi * rx * sinTheta1 - sinPhi * ry * cosTheta1)</span>
<span class="lineno"> 231 </span><span class="spaces"> </span><span class="istickedoff">dy1 = t * (-sinPhi * rx * sinTheta1 + cosPhi * ry * cosTheta1)</span>
<span class="lineno"> 232 </span><span class="spaces"></span><span class="istickedoff"></span>
<span class="lineno"> 233 </span><span class="spaces"> </span><span class="istickedoff">dxe = t * (cosPhi * rx * sinTheta2 + sinPhi * ry * cosTheta2)</span>
<span class="lineno"> 234 </span><span class="spaces"> </span><span class="istickedoff">dye = t * (sinPhi * rx * sinTheta2 - cosPhi * ry * cosTheta2)</span></span>
<span class="lineno"> 235 </span>
<span class="lineno"> 236 </span>partialBezierPoints :: [RPoint] -&gt; Double -&gt; Double -&gt; [RPoint]
<span class="lineno"> 237 </span><span class="decl"><span class="istickedoff">partialBezierPoints ps a b =</span>
<span class="lineno"> 238 </span><span class="spaces"> </span><span class="istickedoff">let c1 = Bezier.AnyBezier (V.fromList ps)</span>
<span class="lineno"> 239 </span><span class="spaces"> </span><span class="istickedoff">Bezier.AnyBezier os = Bezier.bezierSubsegment c1 a b</span>
<span class="lineno"> 240 </span><span class="spaces"> </span><span class="istickedoff">in V.toList os</span></span>
<span class="lineno"> 241 </span>
<span class="lineno"> 242 </span>interpolatePathCommands :: Double -&gt; [PathCommand] -&gt; [PathCommand]
<span class="lineno"> 243 </span><span class="decl"><span class="nottickedoff">interpolatePathCommands alpha = lineToPath . partialLine alpha . toLineCommands</span></span>
<span class="lineno"> 244 </span>
<span class="lineno"> 245 </span>{- | Create an image showing portion of a path.
<span class="lineno"> 246 </span> Note that this only affects paths (see 'Reanimate.Svg.Constructors.mkPath').
<span class="lineno"> 247 </span> You can also use this with other SVG shapes if you convert them to path first (see 'Reanimate.Svg.pathify').
<span class="lineno"> 248 </span>
<span class="lineno"> 249 </span> Typical usage:
<span class="lineno"> 250 </span>
<span class="lineno"> 251 </span> &gt; animate $ \t -&gt; partialSvg t myPath
<span class="lineno"> 252 </span>-}
<span class="lineno"> 253 </span>partialSvg :: Double -- ^ number between 0 and 1 inclusively, determining what portion of the path to show
<span class="lineno"> 254 </span> -&gt; Tree -- ^ Image representing a path, of which we only want to display a portion determined by the first argument
<span class="lineno"> 255 </span> -&gt; Tree
<span class="lineno"> 256 </span><span class="decl"><span class="istickedoff">partialSvg alpha | alpha &gt;= 1 = id</span>
<span class="lineno"> 257 </span><span class="spaces"></span><span class="istickedoff">partialSvg alpha = mapTree worker</span>
<span class="lineno"> 258 </span><span class="spaces"> </span><span class="istickedoff">where</span>
<span class="lineno"> 259 </span><span class="spaces"> </span><span class="istickedoff">worker (PathTree path) =</span>
<span class="lineno"> 260 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ path &amp; pathDefinition %~ lineToPath . partialLine alpha . toLineCommands</span>
<span class="lineno"> 261 </span><span class="spaces"> </span><span class="istickedoff">worker t = t</span></span>
</pre>
</body>
</html>
Reference in a new issue View git blame Copy permalink