mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-15 18:12:20 +00:00
Deploying to gh-pages from @ d1b0a50e51 🚀
This commit is contained in:
Lemmih
parent
cc0c9094cc
commit
b86ff4e028
16 changed files with 2552 additions and 2469 deletions
28
haddock.txt
28
haddock.txt
|
|
@ -1,25 +1,29 @@
|
|||
100% ( 55 / 55) in 'Reanimate.Svg.Constructors'
|
||||
100% ( 22 / 22) in 'Reanimate.Effect'
|
||||
100% ( 17 / 17) in 'Reanimate.Parameters'
|
||||
100% ( 13 / 13) in 'Reanimate.ColorMap'
|
||||
100% ( 12 / 12) in 'Reanimate.ColorComponents'
|
||||
100% ( 9 / 9) in 'Reanimate.Voice'
|
||||
100% ( 9 / 9) in 'Reanimate.Povray'
|
||||
100% ( 9 / 9) in 'Reanimate.Constants'
|
||||
94% (145 /155) in 'Reanimate'
|
||||
100% ( 5 / 5) in 'Reanimate.Transform'
|
||||
100% ( 4 / 4) in 'Reanimate.Svg.BoundingBox'
|
||||
100% ( 3 / 3) in 'Reanimate.Blender'
|
||||
99% (154 /155) in 'Reanimate'
|
||||
95% ( 40 / 42) in 'Reanimate.Animation'
|
||||
93% ( 13 / 14) in 'Reanimate.Raster'
|
||||
91% ( 10 / 11) in 'Reanimate.Ease'
|
||||
88% ( 7 / 8) in 'Reanimate.Transition'
|
||||
85% ( 47 / 55) in 'Reanimate.Svg.Constructors'
|
||||
77% ( 33 / 43) in 'Reanimate.Animation'
|
||||
73% ( 8 / 11) in 'Reanimate.Ease'
|
||||
71% ( 10 / 14) in 'Reanimate.Raster'
|
||||
67% ( 6 / 9) in 'Reanimate.Voice'
|
||||
75% ( 6 / 8) in 'Reanimate.Builtin.Documentation'
|
||||
75% ( 3 / 4) in 'Reanimate.Svg.Unuse'
|
||||
67% ( 4 / 6) in 'Reanimate.Builtin.Images'
|
||||
56% ( 10 / 18) in 'Reanimate.Svg'
|
||||
50% ( 1 / 2) in 'Reanimate.Builtin.CirclePlot'
|
||||
44% ( 4 / 9) in 'Reanimate.LaTeX'
|
||||
42% ( 47 /111) in 'Reanimate.Scene'
|
||||
42% ( 17 / 40) in 'Reanimate.GeoProjection'
|
||||
41% ( 45 /111) in 'Reanimate.Scene'
|
||||
38% ( 3 / 8) in 'Reanimate.Builtin.Documentation'
|
||||
33% ( 4 / 12) in 'Reanimate.Render'
|
||||
28% ( 5 / 18) in 'Reanimate.Svg'
|
||||
25% ( 1 / 4) in 'Reanimate.Builtin.Slide'
|
||||
17% ( 1 / 6) in 'Reanimate.Svg.BoundingBox'
|
||||
12% ( 2 / 17) in 'Reanimate.Math.SSSP'
|
||||
10% ( 3 / 30) in 'Reanimate.PolyShape'
|
||||
7% ( 2 / 29) in 'Reanimate.Math.Common'
|
||||
|
|
@ -34,7 +38,6 @@
|
|||
0% ( 0 / 10) in 'Reanimate.Math.Render'
|
||||
0% ( 0 / 10) in 'Reanimate.ColorSpace'
|
||||
0% ( 0 / 10) in 'Reanimate.Builtin.TernaryPlot'
|
||||
0% ( 0 / 9) in 'Reanimate.Povray'
|
||||
0% ( 0 / 9) in 'Reanimate.Math.Smooth'
|
||||
0% ( 0 / 8) in 'Reanimate.Misc'
|
||||
0% ( 0 / 8) in 'Reanimate.Math.Balloon'
|
||||
|
|
@ -43,12 +46,9 @@
|
|||
0% ( 0 / 6) in 'Reanimate.Morph.Linear'
|
||||
0% ( 0 / 6) in 'Reanimate.Math.Triangulate'
|
||||
0% ( 0 / 6) in 'Reanimate.Math.EarClip'
|
||||
0% ( 0 / 5) in 'Reanimate.Transform'
|
||||
0% ( 0 / 5) in 'Reanimate.Builtin.Flip'
|
||||
0% ( 0 / 4) in 'Reanimate.Svg.Unuse'
|
||||
0% ( 0 / 4) in 'Reanimate.Debug'
|
||||
0% ( 0 / 3) in 'Reanimate.Morph.Rotational'
|
||||
0% ( 0 / 3) in 'Reanimate.Morph.LineBend'
|
||||
0% ( 0 / 3) in 'Reanimate.Memo'
|
||||
0% ( 0 / 3) in 'Reanimate.Blender'
|
||||
0% ( 0 / 2) in 'Reanimate.Morph.Cache'
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
{ "schemaVersion": 1, "label": "api docs", "message": "34%", "color": "success" }
|
||||
{ "schemaVersion": 1, "label": "api docs", "message": "41%", "color": "success" }
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }
|
|||
<td align="right">20%</td><td>3/15</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="20%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">- </td><td>0/0</td><td width=100> </td><td align="right">20%</td><td>12/58</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="20%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr>
|
||||
<td> <tt>module <a href="reanimate-0.4.1.0-inplace/Reanimate.Animation.hs.html">reanimate-0.4.1.0-inplace/Reanimate.Animation</a></tt></td>
|
||||
<td align="right">84%</td><td>28/33</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="84%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">57%</td><td>8/14</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="57%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">85%</td><td>298/349</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="85%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<td align="right">87%</td><td>28/32</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="87%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">57%</td><td>8/14</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="57%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">85%</td><td>298/347</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="85%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr>
|
||||
<td> <tt>module <a href="reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation.hs.html">reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation</a></tt></td>
|
||||
<td align="right">85%</td><td>6/7</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="85%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">- </td><td>0/0</td><td width=100> </td><td align="right">87%</td><td>117/134</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="87%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
|
|
@ -131,5 +131,5 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }
|
|||
<td align="right">100%</td><td>6/6</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="100%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">50%</td><td>1/2</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="50%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">95%</td><td>43/45</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="95%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr></tr><tr style="background: #e0e0e0">
|
||||
<th align=left> Program Coverage Total</tt></th>
|
||||
<td align="right">31%</td><td>253/803</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="31%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">16%</td><td>131/811</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="16%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">30%</td><td>4760/15671</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="30%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<td align="right">31%</td><td>253/802</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="31%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">16%</td><td>131/811</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="16%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">30%</td><td>4760/15669</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="30%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
</table></body></html>
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }
|
|||
<td align="right">75%</td><td>12/16</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="75%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">58%</td><td>43/74</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="58%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">69%</td><td>659/943</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="69%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr>
|
||||
<td> <tt>module <a href="reanimate-0.4.1.0-inplace/Reanimate.Animation.hs.html">reanimate-0.4.1.0-inplace/Reanimate.Animation</a></tt></td>
|
||||
<td align="right">84%</td><td>28/33</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="84%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">57%</td><td>8/14</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="57%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">85%</td><td>298/349</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="85%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<td align="right">87%</td><td>28/32</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="87%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">57%</td><td>8/14</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="57%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">85%</td><td>298/347</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="85%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr>
|
||||
<td> <tt>module <a href="reanimate-0.4.1.0-inplace/Reanimate.Chiphunk.hs.html">reanimate-0.4.1.0-inplace/Reanimate.Chiphunk</a></tt></td>
|
||||
<td align="right">57%</td><td>4/7</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="57%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">50%</td><td>2/4</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="50%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">63%</td><td>121/192</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="63%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
|
|
@ -131,5 +131,5 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }
|
|||
<td align="right">15%</td><td>3/20</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="15%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">- </td><td>0/0</td><td width=100> </td><td align="right">14%</td><td>7/49</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="14%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr></tr><tr style="background: #e0e0e0">
|
||||
<th align=left> Program Coverage Total</tt></th>
|
||||
<td align="right">31%</td><td>253/803</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="31%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">16%</td><td>131/811</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="16%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">30%</td><td>4760/15671</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="30%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<td align="right">31%</td><td>253/802</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="31%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">16%</td><td>131/811</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="16%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">30%</td><td>4760/15669</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="30%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
</table></body></html>
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }
|
|||
<td align="right">85%</td><td>6/7</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="85%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">- </td><td>0/0</td><td width=100> </td><td align="right">87%</td><td>117/134</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="87%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr>
|
||||
<td> <tt>module <a href="reanimate-0.4.1.0-inplace/Reanimate.Animation.hs.html">reanimate-0.4.1.0-inplace/Reanimate.Animation</a></tt></td>
|
||||
<td align="right">84%</td><td>28/33</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="84%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">57%</td><td>8/14</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="57%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">85%</td><td>298/349</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="85%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<td align="right">87%</td><td>28/32</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="87%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">57%</td><td>8/14</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="57%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">85%</td><td>298/347</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="85%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr>
|
||||
<td> <tt>module <a href="reanimate-0.4.1.0-inplace/Reanimate.ColorComponents.hs.html">reanimate-0.4.1.0-inplace/Reanimate.ColorComponents</a></tt></td>
|
||||
<td align="right">75%</td><td>9/12</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="75%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">50%</td><td>1/2</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="50%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">81%</td><td>135/166</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="81%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
|
|
@ -131,5 +131,5 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }
|
|||
<td align="right">0%</td><td>0/1</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="100%"><tr><td height=12 class="invbar"></td></tr></table></td></tr></table></td><td align="right">0%</td><td>0/4</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="100%"><tr><td height=12 class="invbar"></td></tr></table></td></tr></table></td><td align="right">0%</td><td>0/61</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="100%"><tr><td height=12 class="invbar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr></tr><tr style="background: #e0e0e0">
|
||||
<th align=left> Program Coverage Total</tt></th>
|
||||
<td align="right">31%</td><td>253/803</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="31%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">16%</td><td>131/811</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="16%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">30%</td><td>4760/15671</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="30%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<td align="right">31%</td><td>253/802</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="31%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">16%</td><td>131/811</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="16%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">30%</td><td>4760/15669</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="30%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
</table></body></html>
|
||||
|
|
|
|||
|
|
@ -13,12 +13,12 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }
|
|||
<td> <tt>module <a href="reanimate-0.4.1.0-inplace/Reanimate.Transition.hs.html">reanimate-0.4.1.0-inplace/Reanimate.Transition</a></tt></td>
|
||||
<td align="right">100%</td><td>6/6</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="100%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">50%</td><td>1/2</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="50%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">95%</td><td>43/45</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="95%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr>
|
||||
<td> <tt>module <a href="reanimate-0.4.1.0-inplace/Reanimate.Animation.hs.html">reanimate-0.4.1.0-inplace/Reanimate.Animation</a></tt></td>
|
||||
<td align="right">87%</td><td>28/32</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="87%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">57%</td><td>8/14</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="57%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">85%</td><td>298/347</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="85%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr>
|
||||
<td> <tt>module <a href="reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation.hs.html">reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation</a></tt></td>
|
||||
<td align="right">85%</td><td>6/7</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="85%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">- </td><td>0/0</td><td width=100> </td><td align="right">87%</td><td>117/134</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="87%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr>
|
||||
<td> <tt>module <a href="reanimate-0.4.1.0-inplace/Reanimate.Animation.hs.html">reanimate-0.4.1.0-inplace/Reanimate.Animation</a></tt></td>
|
||||
<td align="right">84%</td><td>28/33</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="84%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">57%</td><td>8/14</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="57%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">85%</td><td>298/349</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="85%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr>
|
||||
<td> <tt>module <a href="reanimate-0.4.1.0-inplace/Reanimate.Transform.hs.html">reanimate-0.4.1.0-inplace/Reanimate.Transform</a></tt></td>
|
||||
<td align="right">83%</td><td>5/6</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="83%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">33%</td><td>4/12</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="33%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">45%</td><td>76/166</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="45%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr>
|
||||
|
|
@ -131,5 +131,5 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }
|
|||
<td align="right">0%</td><td>0/1</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="100%"><tr><td height=12 class="invbar"></td></tr></table></td></tr></table></td><td align="right">0%</td><td>0/4</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="100%"><tr><td height=12 class="invbar"></td></tr></table></td></tr></table></td><td align="right">0%</td><td>0/61</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="100%"><tr><td height=12 class="invbar"></td></tr></table></td></tr></table></td></tr>
|
||||
<tr></tr><tr style="background: #e0e0e0">
|
||||
<th align=left> Program Coverage Total</tt></th>
|
||||
<td align="right">31%</td><td>253/803</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="31%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">16%</td><td>131/811</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="16%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">30%</td><td>4760/15671</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="30%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
<td align="right">31%</td><td>253/802</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="31%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">16%</td><td>131/811</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="16%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td><td align="right">30%</td><td>4760/15669</td><td width=100><table cellpadding=0 cellspacing=0 width="100" class="bar"><tr><td><table cellpadding=0 cellspacing=0 width="30%"><tr><td height=12 class="bar"></td></tr></table></td></tr></table></td></tr>
|
||||
</table></body></html>
|
||||
|
|
|
|||
|
|
@ -54,351 +54,357 @@ span.spaces { background: white }
|
|||
<span class="lineno"> 35 </span> , freezeAtPercentage
|
||||
<span class="lineno"> 36 </span> , addStatic
|
||||
<span class="lineno"> 37 </span> -- * Misc
|
||||
<span class="lineno"> 38 </span> , (#)
|
||||
<span class="lineno"> 39 </span> , getAnimationFrame
|
||||
<span class="lineno"> 40 </span> , Sync(..)
|
||||
<span class="lineno"> 41 </span> -- * Rendering
|
||||
<span class="lineno"> 42 </span> , renderTree
|
||||
<span class="lineno"> 43 </span> , renderSvg
|
||||
<span class="lineno"> 44 </span> ) where
|
||||
<span class="lineno"> 45 </span>
|
||||
<span class="lineno"> 46 </span>import Control.Arrow ()
|
||||
<span class="lineno"> 47 </span>import Data.Fixed (mod')
|
||||
<span class="lineno"> 48 </span>import Graphics.SvgTree (Alignment (..), Document (..),
|
||||
<span class="lineno"> 49 </span> Number (..),
|
||||
<span class="lineno"> 50 </span> PreserveAspectRatio (..),
|
||||
<span class="lineno"> 51 </span> Tree (..), xmlOfTree)
|
||||
<span class="lineno"> 52 </span>import Graphics.SvgTree.Printer
|
||||
<span class="lineno"> 53 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 54 </span>import Reanimate.Ease
|
||||
<span class="lineno"> 55 </span>import Reanimate.Svg.Constructors
|
||||
<span class="lineno"> 56 </span>import Text.XML.Light.Output
|
||||
<span class="lineno"> 57 </span>
|
||||
<span class="lineno"> 58 </span>-- | Duration of an animation or effect. Usually measured in seconds.
|
||||
<span class="lineno"> 59 </span>type Duration = Double
|
||||
<span class="lineno"> 60 </span>-- | Time signal. Goes from 0 to 1, inclusive.
|
||||
<span class="lineno"> 61 </span>type Time = Double
|
||||
<span class="lineno"> 62 </span>
|
||||
<span class="lineno"> 38 </span> , getAnimationFrame
|
||||
<span class="lineno"> 39 </span> , Sync(..)
|
||||
<span class="lineno"> 40 </span> -- * Rendering
|
||||
<span class="lineno"> 41 </span> , renderTree
|
||||
<span class="lineno"> 42 </span> , renderSvg
|
||||
<span class="lineno"> 43 </span> ) where
|
||||
<span class="lineno"> 44 </span>
|
||||
<span class="lineno"> 45 </span>import Control.Arrow ()
|
||||
<span class="lineno"> 46 </span>import Data.Fixed (mod')
|
||||
<span class="lineno"> 47 </span>import Graphics.SvgTree (Alignment (..), Document (..),
|
||||
<span class="lineno"> 48 </span> Number (..),
|
||||
<span class="lineno"> 49 </span> PreserveAspectRatio (..),
|
||||
<span class="lineno"> 50 </span> Tree (..), xmlOfTree)
|
||||
<span class="lineno"> 51 </span>import Graphics.SvgTree.Printer
|
||||
<span class="lineno"> 52 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 53 </span>import Reanimate.Ease
|
||||
<span class="lineno"> 54 </span>import Reanimate.Svg.Constructors
|
||||
<span class="lineno"> 55 </span>import Text.XML.Light.Output
|
||||
<span class="lineno"> 56 </span>
|
||||
<span class="lineno"> 57 </span>-- | Duration of an animation or effect. Usually measured in seconds.
|
||||
<span class="lineno"> 58 </span>type Duration = Double
|
||||
<span class="lineno"> 59 </span>-- | Time signal. Goes from 0 to 1, inclusive.
|
||||
<span class="lineno"> 60 </span>type Time = Double
|
||||
<span class="lineno"> 61 </span>
|
||||
<span class="lineno"> 62 </span>-- | SVG node.
|
||||
<span class="lineno"> 63 </span>type SVG = Tree
|
||||
<span class="lineno"> 64 </span>
|
||||
<span class="lineno"> 65 </span>-- | Animations are SVGs over a finite time.
|
||||
<span class="lineno"> 66 </span>data Animation = Animation Duration (Time -> SVG)
|
||||
<span class="lineno"> 67 </span>
|
||||
<span class="lineno"> 68 </span>mkAnimation :: Duration -> (Time -> SVG) -> Animation
|
||||
<span class="lineno"> 69 </span><span class="decl"><span class="istickedoff">mkAnimation = Animation</span></span>
|
||||
<span class="lineno"> 70 </span>
|
||||
<span class="lineno"> 71 </span>-- | Construct an animation with a duration of @1@.
|
||||
<span class="lineno"> 72 </span>animate :: (Time -> SVG) -> Animation
|
||||
<span class="lineno"> 73 </span><span class="decl"><span class="istickedoff">animate = Animation 1</span></span>
|
||||
<span class="lineno"> 74 </span>
|
||||
<span class="lineno"> 75 </span>-- | Create an animation with provided @duration@, which consists of stationary frame displayed for its entire duration.
|
||||
<span class="lineno"> 76 </span>staticFrame :: Duration -> SVG -> Animation
|
||||
<span class="lineno"> 77 </span><span class="decl"><span class="istickedoff">staticFrame d svg = Animation d (const svg)</span></span>
|
||||
<span class="lineno"> 78 </span>
|
||||
<span class="lineno"> 79 </span>-- | Query the duration of an animation.
|
||||
<span class="lineno"> 80 </span>duration :: Animation -> Duration
|
||||
<span class="lineno"> 81 </span><span class="decl"><span class="istickedoff">duration (Animation d _) = d</span></span>
|
||||
<span class="lineno"> 82 </span>
|
||||
<span class="lineno"> 83 </span>-- | Play animations in sequence. The @lhs@ animation is removed after it has
|
||||
<span class="lineno"> 84 </span>-- completed. New animation duration is '@duration lhs + duration rhs@'.
|
||||
<span class="lineno"> 85 </span>--
|
||||
<span class="lineno"> 86 </span>-- Example:
|
||||
<span class="lineno"> 87 </span>--
|
||||
<span class="lineno"> 88 </span>-- > drawBox `seqA` drawCircle
|
||||
<span class="lineno"> 89 </span>--
|
||||
<span class="lineno"> 90 </span>-- <<docs/gifs/doc_seqA.gif>>
|
||||
<span class="lineno"> 91 </span>seqA :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 92 </span><span class="decl"><span class="istickedoff">seqA (Animation d1 f1) (Animation d2 f2) =</span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="istickedoff">Animation totalD $ \t -></span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="istickedoff">if t < d1/totalD</span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="istickedoff">then f1 (t * totalD/d1)</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="istickedoff">else f2 ((t-d1/totalD) * totalD/d2)</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="istickedoff">totalD = d1+d2</span></span>
|
||||
<span class="lineno"> 99 </span>
|
||||
<span class="lineno"> 100 </span>-- | Play two animation concurrently. Shortest animation freezes on last frame.
|
||||
<span class="lineno"> 101 </span>-- New animation duration is '@max (duration lhs) (duration rhs)@'.
|
||||
<span class="lineno"> 102 </span>--
|
||||
<span class="lineno"> 103 </span>-- Example:
|
||||
<span class="lineno"> 104 </span>--
|
||||
<span class="lineno"> 105 </span>-- > drawBox `parA` adjustDuration (*2) drawCircle
|
||||
<span class="lineno"> 106 </span>--
|
||||
<span class="lineno"> 107 </span>-- <<docs/gifs/doc_parA.gif>>
|
||||
<span class="lineno"> 108 </span>parA :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 109 </span><span class="decl"><span class="istickedoff">parA (Animation d1 f1) (Animation d2 f2) =</span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="istickedoff">Animation (max d1 d2) $ \t -></span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="istickedoff">let t1 = t * totalD/d1</span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="istickedoff">t2 = t * totalD/d2 in</span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="istickedoff">mkGroup</span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="istickedoff">[ f1 (min 1 t1)</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="istickedoff">, f2 (min 1 t2) ]</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff">totalD = max d1 d2</span></span>
|
||||
<span class="lineno"> 118 </span>
|
||||
<span class="lineno"> 119 </span>-- | Play two animation concurrently. Shortest animation loops.
|
||||
<span class="lineno"> 120 </span>-- New animation duration is '@max (duration lhs) (duration rhs)@'.
|
||||
<span class="lineno"> 121 </span>--
|
||||
<span class="lineno"> 122 </span>-- Example:
|
||||
<span class="lineno"> 123 </span>--
|
||||
<span class="lineno"> 124 </span>-- > drawBox `parLoopA` adjustDuration (*2) drawCircle
|
||||
<span class="lineno"> 125 </span>--
|
||||
<span class="lineno"> 126 </span>-- <<docs/gifs/doc_parLoopA.gif>>
|
||||
<span class="lineno"> 127 </span>parLoopA :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 128 </span><span class="decl"><span class="istickedoff">parLoopA (Animation d1 f1) (Animation d2 f2) =</span>
|
||||
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="istickedoff">Animation totalD $ \t -></span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="istickedoff">let t1 = t * totalD/d1</span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="istickedoff">t2 = t * totalD/d2 in</span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="istickedoff">mkGroup</span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="istickedoff">[ f1 (t1 `mod'` 1)</span>
|
||||
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="istickedoff">, f2 (t2 `mod'` 1) ]</span>
|
||||
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="istickedoff">totalD = max d1 d2</span></span>
|
||||
<span class="lineno"> 137 </span>
|
||||
<span class="lineno"> 138 </span>-- | Play two animation concurrently. Animations disappear after playing once.
|
||||
<span class="lineno"> 139 </span>-- New animation duration is '@max (duration lhs) (duration rhs)@'.
|
||||
<span class="lineno"> 140 </span>--
|
||||
<span class="lineno"> 141 </span>-- Example:
|
||||
<span class="lineno"> 142 </span>--
|
||||
<span class="lineno"> 143 </span>-- > drawBox `parLoopA` adjustDuration (*2) drawCircle
|
||||
<span class="lineno"> 144 </span>--
|
||||
<span class="lineno"> 145 </span>-- <<docs/gifs/doc_parDropA.gif>>
|
||||
<span class="lineno"> 146 </span>parDropA :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 147 </span><span class="decl"><span class="istickedoff">parDropA (Animation d1 f1) (Animation d2 f2) =</span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="istickedoff">Animation totalD $ \t -></span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="istickedoff">let t1 = t * totalD/d1</span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="istickedoff">t2 = t * totalD/d2 in</span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="istickedoff">mkGroup</span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="istickedoff">[ if t1>1 then None else f1 t1</span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="istickedoff">, if <span class="tickonlyfalse">t2>1</span> then <span class="nottickedoff">None</span> else f2 t2 ]</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="istickedoff">totalD = max d1 d2</span></span>
|
||||
<span class="lineno"> 156 </span>
|
||||
<span class="lineno"> 157 </span>-- | Empty animation (no SVG output) with a fixed duration.
|
||||
<span class="lineno"> 158 </span>--
|
||||
<span class="lineno"> 159 </span>-- Example:
|
||||
<span class="lineno"> 160 </span>--
|
||||
<span class="lineno"> 161 </span>-- > pause 1 `seqA` drawProgress
|
||||
<span class="lineno"> 162 </span>--
|
||||
<span class="lineno"> 163 </span>-- <<docs/gifs/doc_pause.gif>>
|
||||
<span class="lineno"> 164 </span>pause :: Duration -> Animation
|
||||
<span class="lineno"> 165 </span><span class="decl"><span class="istickedoff">pause d = Animation d (const None)</span></span>
|
||||
<span class="lineno"> 166 </span>
|
||||
<span class="lineno"> 167 </span>-- | Play left animation and freeze on the last frame, then play the right
|
||||
<span class="lineno"> 168 </span>-- animation. New duration is '@duration lhs + duration rhs@'.
|
||||
<span class="lineno"> 169 </span>--
|
||||
<span class="lineno"> 170 </span>-- Example:
|
||||
<span class="lineno"> 171 </span>--
|
||||
<span class="lineno"> 172 </span>-- > drawBox `andThen` drawCircle
|
||||
<span class="lineno"> 173 </span>--
|
||||
<span class="lineno"> 174 </span>-- <<docs/gifs/doc_andThen.gif>>
|
||||
<span class="lineno"> 175 </span>andThen :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 176 </span><span class="decl"><span class="istickedoff">andThen a b = a `parA` (pause (duration a) `seqA` b)</span></span>
|
||||
<span class="lineno"> 177 </span>
|
||||
<span class="lineno"> 178 </span>-- | Calculate the frame that would be displayed at given point in @time@ of running @animation@.
|
||||
<span class="lineno"> 179 </span>--
|
||||
<span class="lineno"> 180 </span>-- The provided time parameter is clamped between 0 and animation duration.
|
||||
<span class="lineno"> 181 </span>frameAt :: Time -> Animation -> SVG
|
||||
<span class="lineno"> 182 </span><span class="decl"><span class="istickedoff">frameAt t (Animation d f) = f t'</span>
|
||||
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="istickedoff">t' = clamp 0 1 (t/d)</span></span>
|
||||
<span class="lineno"> 185 </span>
|
||||
<span class="lineno"> 186 </span>renderTree :: SVG -> String
|
||||
<span class="lineno"> 187 </span><span class="decl"><span class="nottickedoff">renderTree t = maybe "" ppElement $ xmlOfTree t</span></span>
|
||||
<span class="lineno"> 188 </span>
|
||||
<span class="lineno"> 189 </span>renderSvg :: Maybe Number -- ^ The number to use as value of the @width@ attribute of the resulting top-level svg element. If @Nothing@, the width attribute won't be rendered.
|
||||
<span class="lineno"> 190 </span> -> Maybe Number -- ^ Similar to previous argument, but for @height@ attribute.
|
||||
<span class="lineno"> 191 </span> -> SVG -- ^ SVG to render
|
||||
<span class="lineno"> 192 </span> -> String -- ^ String representation of SVG XML markup
|
||||
<span class="lineno"> 193 </span><span class="decl"><span class="istickedoff">renderSvg w h t = ppDocument doc</span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"></span><span class="istickedoff">-- renderSvg w h t = ppFastElement (xmlOfDocument doc)</span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="istickedoff">width = 16</span>
|
||||
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="istickedoff">height = 9</span>
|
||||
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="istickedoff">doc = Document</span>
|
||||
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="istickedoff">{ _viewBox = Just (-width/2, -height/2, width, height)</span>
|
||||
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="istickedoff">, _width = w</span>
|
||||
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="istickedoff">, _height = h</span>
|
||||
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="istickedoff">, _elements = [withStrokeWidth defaultStrokeWidth $ scaleXY 1 (-1) t]</span>
|
||||
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="istickedoff">, _description = <span class="nottickedoff">""</span></span>
|
||||
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="istickedoff">, _documentLocation = <span class="nottickedoff">""</span></span>
|
||||
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="istickedoff">, _documentAspectRatio = PreserveAspectRatio False AlignNone Nothing</span>
|
||||
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="istickedoff">}</span></span>
|
||||
<span class="lineno"> 207 </span>
|
||||
<span class="lineno"> 208 </span>-- | Map over the SVG produced by an animation at every frame.
|
||||
<span class="lineno"> 209 </span>--
|
||||
<span class="lineno"> 210 </span>-- Example:
|
||||
<span class="lineno"> 211 </span>--
|
||||
<span class="lineno"> 212 </span>-- > mapA (scale 0.5) drawCircle
|
||||
<span class="lineno"> 213 </span>--
|
||||
<span class="lineno"> 214 </span>-- <<docs/gifs/doc_mapA.gif>>
|
||||
<span class="lineno"> 215 </span>
|
||||
<span class="lineno"> 216 </span>mapA :: (SVG -> SVG) -> Animation -> Animation
|
||||
<span class="lineno"> 217 </span><span class="decl"><span class="istickedoff">mapA fn (Animation d f) = Animation d (fn . f)</span></span>
|
||||
<span class="lineno"> 68 </span>-- | Construct an animation with a given duration.
|
||||
<span class="lineno"> 69 </span>mkAnimation :: Duration -> (Time -> SVG) -> Animation
|
||||
<span class="lineno"> 70 </span><span class="decl"><span class="istickedoff">mkAnimation = Animation</span></span>
|
||||
<span class="lineno"> 71 </span>
|
||||
<span class="lineno"> 72 </span>-- | Construct an animation with a duration of @1@.
|
||||
<span class="lineno"> 73 </span>animate :: (Time -> SVG) -> Animation
|
||||
<span class="lineno"> 74 </span><span class="decl"><span class="istickedoff">animate = Animation 1</span></span>
|
||||
<span class="lineno"> 75 </span>
|
||||
<span class="lineno"> 76 </span>-- | Create an animation with provided @duration@, which consists of stationary frame displayed for its entire duration.
|
||||
<span class="lineno"> 77 </span>staticFrame :: Duration -> SVG -> Animation
|
||||
<span class="lineno"> 78 </span><span class="decl"><span class="istickedoff">staticFrame d svg = Animation d (const svg)</span></span>
|
||||
<span class="lineno"> 79 </span>
|
||||
<span class="lineno"> 80 </span>-- | Query the duration of an animation.
|
||||
<span class="lineno"> 81 </span>duration :: Animation -> Duration
|
||||
<span class="lineno"> 82 </span><span class="decl"><span class="istickedoff">duration (Animation d _) = d</span></span>
|
||||
<span class="lineno"> 83 </span>
|
||||
<span class="lineno"> 84 </span>-- | Play animations in sequence. The @lhs@ animation is removed after it has
|
||||
<span class="lineno"> 85 </span>-- completed. New animation duration is '@duration lhs + duration rhs@'.
|
||||
<span class="lineno"> 86 </span>--
|
||||
<span class="lineno"> 87 </span>-- Example:
|
||||
<span class="lineno"> 88 </span>--
|
||||
<span class="lineno"> 89 </span>-- > drawBox `seqA` drawCircle
|
||||
<span class="lineno"> 90 </span>--
|
||||
<span class="lineno"> 91 </span>-- <<docs/gifs/doc_seqA.gif>>
|
||||
<span class="lineno"> 92 </span>seqA :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 93 </span><span class="decl"><span class="istickedoff">seqA (Animation d1 f1) (Animation d2 f2) =</span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="istickedoff">Animation totalD $ \t -></span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="istickedoff">if t < d1/totalD</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="istickedoff">then f1 (t * totalD/d1)</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="istickedoff">else f2 ((t-d1/totalD) * totalD/d2)</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="istickedoff">totalD = d1+d2</span></span>
|
||||
<span class="lineno"> 100 </span>
|
||||
<span class="lineno"> 101 </span>-- | Play two animation concurrently. Shortest animation freezes on last frame.
|
||||
<span class="lineno"> 102 </span>-- New animation duration is '@max (duration lhs) (duration rhs)@'.
|
||||
<span class="lineno"> 103 </span>--
|
||||
<span class="lineno"> 104 </span>-- Example:
|
||||
<span class="lineno"> 105 </span>--
|
||||
<span class="lineno"> 106 </span>-- > drawBox `parA` adjustDuration (*2) drawCircle
|
||||
<span class="lineno"> 107 </span>--
|
||||
<span class="lineno"> 108 </span>-- <<docs/gifs/doc_parA.gif>>
|
||||
<span class="lineno"> 109 </span>parA :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 110 </span><span class="decl"><span class="istickedoff">parA (Animation d1 f1) (Animation d2 f2) =</span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="istickedoff">Animation (max d1 d2) $ \t -></span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="istickedoff">let t1 = t * totalD/d1</span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="istickedoff">t2 = t * totalD/d2 in</span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="istickedoff">mkGroup</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="istickedoff">[ f1 (min 1 t1)</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff">, f2 (min 1 t2) ]</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="istickedoff">totalD = max d1 d2</span></span>
|
||||
<span class="lineno"> 119 </span>
|
||||
<span class="lineno"> 120 </span>-- | Play two animation concurrently. Shortest animation loops.
|
||||
<span class="lineno"> 121 </span>-- New animation duration is '@max (duration lhs) (duration rhs)@'.
|
||||
<span class="lineno"> 122 </span>--
|
||||
<span class="lineno"> 123 </span>-- Example:
|
||||
<span class="lineno"> 124 </span>--
|
||||
<span class="lineno"> 125 </span>-- > drawBox `parLoopA` adjustDuration (*2) drawCircle
|
||||
<span class="lineno"> 126 </span>--
|
||||
<span class="lineno"> 127 </span>-- <<docs/gifs/doc_parLoopA.gif>>
|
||||
<span class="lineno"> 128 </span>parLoopA :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 129 </span><span class="decl"><span class="istickedoff">parLoopA (Animation d1 f1) (Animation d2 f2) =</span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="istickedoff">Animation totalD $ \t -></span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="istickedoff">let t1 = t * totalD/d1</span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="istickedoff">t2 = t * totalD/d2 in</span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="istickedoff">mkGroup</span>
|
||||
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="istickedoff">[ f1 (t1 `mod'` 1)</span>
|
||||
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="istickedoff">, f2 (t2 `mod'` 1) ]</span>
|
||||
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="istickedoff">totalD = max d1 d2</span></span>
|
||||
<span class="lineno"> 138 </span>
|
||||
<span class="lineno"> 139 </span>-- | Play two animation concurrently. Animations disappear after playing once.
|
||||
<span class="lineno"> 140 </span>-- New animation duration is '@max (duration lhs) (duration rhs)@'.
|
||||
<span class="lineno"> 141 </span>--
|
||||
<span class="lineno"> 142 </span>-- Example:
|
||||
<span class="lineno"> 143 </span>--
|
||||
<span class="lineno"> 144 </span>-- > drawBox `parLoopA` adjustDuration (*2) drawCircle
|
||||
<span class="lineno"> 145 </span>--
|
||||
<span class="lineno"> 146 </span>-- <<docs/gifs/doc_parDropA.gif>>
|
||||
<span class="lineno"> 147 </span>parDropA :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 148 </span><span class="decl"><span class="istickedoff">parDropA (Animation d1 f1) (Animation d2 f2) =</span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="istickedoff">Animation totalD $ \t -></span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="istickedoff">let t1 = t * totalD/d1</span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="istickedoff">t2 = t * totalD/d2 in</span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="istickedoff">mkGroup</span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="istickedoff">[ if t1>1 then None else f1 t1</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="istickedoff">, if <span class="tickonlyfalse">t2>1</span> then <span class="nottickedoff">None</span> else f2 t2 ]</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="istickedoff">totalD = max d1 d2</span></span>
|
||||
<span class="lineno"> 157 </span>
|
||||
<span class="lineno"> 158 </span>-- | Empty animation (no SVG output) with a fixed duration.
|
||||
<span class="lineno"> 159 </span>--
|
||||
<span class="lineno"> 160 </span>-- Example:
|
||||
<span class="lineno"> 161 </span>--
|
||||
<span class="lineno"> 162 </span>-- > pause 1 `seqA` drawProgress
|
||||
<span class="lineno"> 163 </span>--
|
||||
<span class="lineno"> 164 </span>-- <<docs/gifs/doc_pause.gif>>
|
||||
<span class="lineno"> 165 </span>pause :: Duration -> Animation
|
||||
<span class="lineno"> 166 </span><span class="decl"><span class="istickedoff">pause d = Animation d (const None)</span></span>
|
||||
<span class="lineno"> 167 </span>
|
||||
<span class="lineno"> 168 </span>-- | Play left animation and freeze on the last frame, then play the right
|
||||
<span class="lineno"> 169 </span>-- animation. New duration is '@duration lhs + duration rhs@'.
|
||||
<span class="lineno"> 170 </span>--
|
||||
<span class="lineno"> 171 </span>-- Example:
|
||||
<span class="lineno"> 172 </span>--
|
||||
<span class="lineno"> 173 </span>-- > drawBox `andThen` drawCircle
|
||||
<span class="lineno"> 174 </span>--
|
||||
<span class="lineno"> 175 </span>-- <<docs/gifs/doc_andThen.gif>>
|
||||
<span class="lineno"> 176 </span>andThen :: Animation -> Animation -> Animation
|
||||
<span class="lineno"> 177 </span><span class="decl"><span class="istickedoff">andThen a b = a `parA` (pause (duration a) `seqA` b)</span></span>
|
||||
<span class="lineno"> 178 </span>
|
||||
<span class="lineno"> 179 </span>-- | Calculate the frame that would be displayed at given point in @time@ of running @animation@.
|
||||
<span class="lineno"> 180 </span>--
|
||||
<span class="lineno"> 181 </span>-- The provided time parameter is clamped between 0 and animation duration.
|
||||
<span class="lineno"> 182 </span>frameAt :: Time -> Animation -> SVG
|
||||
<span class="lineno"> 183 </span><span class="decl"><span class="istickedoff">frameAt t (Animation d f) = f t'</span>
|
||||
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="istickedoff">t' = clamp 0 1 (t/d)</span></span>
|
||||
<span class="lineno"> 186 </span>
|
||||
<span class="lineno"> 187 </span>-- | Helper function for pretty-printing SVG nodes.
|
||||
<span class="lineno"> 188 </span>renderTree :: SVG -> String
|
||||
<span class="lineno"> 189 </span><span class="decl"><span class="nottickedoff">renderTree t = maybe "" ppElement $ xmlOfTree t</span></span>
|
||||
<span class="lineno"> 190 </span>
|
||||
<span class="lineno"> 191 </span>-- | Helper function for pretty-printing SVG nodes as SVG documents.
|
||||
<span class="lineno"> 192 </span>renderSvg :: Maybe Number -- ^ The number to use as value of the @width@ attribute of the resulting top-level svg element. If @Nothing@, the width attribute won't be rendered.
|
||||
<span class="lineno"> 193 </span> -> Maybe Number -- ^ Similar to previous argument, but for @height@ attribute.
|
||||
<span class="lineno"> 194 </span> -> SVG -- ^ SVG to render
|
||||
<span class="lineno"> 195 </span> -> String -- ^ String representation of SVG XML markup
|
||||
<span class="lineno"> 196 </span><span class="decl"><span class="istickedoff">renderSvg w h t = ppDocument doc</span>
|
||||
<span class="lineno"> 197 </span><span class="spaces"></span><span class="istickedoff">-- renderSvg w h t = ppFastElement (xmlOfDocument doc)</span>
|
||||
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="istickedoff">width = 16</span>
|
||||
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="istickedoff">height = 9</span>
|
||||
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="istickedoff">doc = Document</span>
|
||||
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="istickedoff">{ _viewBox = Just (-width/2, -height/2, width, height)</span>
|
||||
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="istickedoff">, _width = w</span>
|
||||
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="istickedoff">, _height = h</span>
|
||||
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="istickedoff">, _elements = [withStrokeWidth defaultStrokeWidth $ scaleXY 1 (-1) t]</span>
|
||||
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="istickedoff">, _description = <span class="nottickedoff">""</span></span>
|
||||
<span class="lineno"> 207 </span><span class="spaces"> </span><span class="istickedoff">, _documentLocation = <span class="nottickedoff">""</span></span>
|
||||
<span class="lineno"> 208 </span><span class="spaces"> </span><span class="istickedoff">, _documentAspectRatio = PreserveAspectRatio False AlignNone Nothing</span>
|
||||
<span class="lineno"> 209 </span><span class="spaces"> </span><span class="istickedoff">}</span></span>
|
||||
<span class="lineno"> 210 </span>
|
||||
<span class="lineno"> 211 </span>-- | Map over the SVG produced by an animation at every frame.
|
||||
<span class="lineno"> 212 </span>--
|
||||
<span class="lineno"> 213 </span>-- Example:
|
||||
<span class="lineno"> 214 </span>--
|
||||
<span class="lineno"> 215 </span>-- > mapA (scale 0.5) drawCircle
|
||||
<span class="lineno"> 216 </span>--
|
||||
<span class="lineno"> 217 </span>-- <<docs/gifs/doc_mapA.gif>>
|
||||
<span class="lineno"> 218 </span>
|
||||
<span class="lineno"> 219 </span>-- | Freeze the last frame for @t@ seconds at the end of the animation.
|
||||
<span class="lineno"> 220 </span>--
|
||||
<span class="lineno"> 221 </span>-- Example:
|
||||
<span class="lineno"> 222 </span>--
|
||||
<span class="lineno"> 223 </span>-- > pauseAtEnd 1 drawProgress
|
||||
<span class="lineno"> 224 </span>--
|
||||
<span class="lineno"> 225 </span>-- <<docs/gifs/doc_pauseAtEnd.gif>>
|
||||
<span class="lineno"> 226 </span>pauseAtEnd :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 227 </span><span class="decl"><span class="istickedoff">pauseAtEnd t a = a `andThen` pause t</span></span>
|
||||
<span class="lineno"> 228 </span>
|
||||
<span class="lineno"> 229 </span>-- | Freeze the first frame for @t@ seconds at the beginning of the animation.
|
||||
<span class="lineno"> 230 </span>--
|
||||
<span class="lineno"> 231 </span>-- Example:
|
||||
<span class="lineno"> 232 </span>--
|
||||
<span class="lineno"> 233 </span>-- > pauseAtBeginning 1 drawProgress
|
||||
<span class="lineno"> 234 </span>--
|
||||
<span class="lineno"> 235 </span>-- <<docs/gifs/doc_pauseAtBeginning.gif>>
|
||||
<span class="lineno"> 236 </span>pauseAtBeginning :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 237 </span><span class="decl"><span class="istickedoff">pauseAtBeginning t a =</span>
|
||||
<span class="lineno"> 238 </span><span class="spaces"> </span><span class="istickedoff">Animation t (freezeFrame 0 a) `seqA` a</span></span>
|
||||
<span class="lineno"> 239 </span>
|
||||
<span class="lineno"> 240 </span>-- | Freeze the first and the last frame of the animation for a specified duration.
|
||||
<span class="lineno"> 241 </span>--
|
||||
<span class="lineno"> 242 </span>-- Example:
|
||||
<span class="lineno"> 243 </span>--
|
||||
<span class="lineno"> 244 </span>-- > pauseAround 1 1 drawProgress
|
||||
<span class="lineno"> 245 </span>--
|
||||
<span class="lineno"> 246 </span>-- <<docs/gifs/doc_pauseAround.gif>>
|
||||
<span class="lineno"> 247 </span>pauseAround :: Duration -> Duration -> Animation -> Animation
|
||||
<span class="lineno"> 248 </span><span class="decl"><span class="istickedoff">pauseAround start end = pauseAtEnd end . pauseAtBeginning start</span></span>
|
||||
<span class="lineno"> 249 </span>
|
||||
<span class="lineno"> 250 </span>-- XXX: Rename to 'setDurationFreeze'. Add 'setDurationDrop' and
|
||||
<span class="lineno"> 251 </span>-- 'setDurationLoop'.
|
||||
<span class="lineno"> 252 </span>pauseUntil :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 253 </span><span class="decl"><span class="nottickedoff">pauseUntil d a = pauseAtEnd (d-duration a) a</span></span>
|
||||
<span class="lineno"> 254 </span>
|
||||
<span class="lineno"> 255 </span>-- Freeze frame at time @t@.
|
||||
<span class="lineno"> 256 </span>freezeFrame :: Time -> Animation -> (Time -> SVG)
|
||||
<span class="lineno"> 257 </span><span class="decl"><span class="istickedoff">freezeFrame t (Animation d f) = const $ f (t/d)</span></span>
|
||||
<span class="lineno"> 258 </span>
|
||||
<span class="lineno"> 259 </span>-- | Change the duration of an animation. Animates are stretched or squished
|
||||
<span class="lineno"> 260 </span>-- (rather than truncated) to fit the new duration.
|
||||
<span class="lineno"> 261 </span>adjustDuration :: (Duration -> Duration) -> Animation -> Animation
|
||||
<span class="lineno"> 262 </span><span class="decl"><span class="istickedoff">adjustDuration fn (Animation d gen) =</span>
|
||||
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="istickedoff">Animation (fn d) gen</span></span>
|
||||
<span class="lineno"> 264 </span>
|
||||
<span class="lineno"> 265 </span>-- | Set the duration of an animation by adjusting its playback rate. The
|
||||
<span class="lineno"> 266 </span>-- animation is still played from start to finish without being cropped.
|
||||
<span class="lineno"> 267 </span>setDuration :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 268 </span><span class="decl"><span class="nottickedoff">setDuration newD = adjustDuration (const newD)</span></span>
|
||||
<span class="lineno"> 269 </span>
|
||||
<span class="lineno"> 270 </span>-- | Play an animation in reverse. Duration remains unchanged. Shorthand for:
|
||||
<span class="lineno"> 271 </span>-- @'signalA' 'reverseS'@.
|
||||
<span class="lineno"> 272 </span>--
|
||||
<span class="lineno"> 273 </span>-- Example:
|
||||
<span class="lineno"> 274 </span>--
|
||||
<span class="lineno"> 275 </span>-- > reverseA drawCircle
|
||||
<span class="lineno"> 276 </span>--
|
||||
<span class="lineno"> 277 </span>-- <<docs/gifs/doc_reverseA.gif>>
|
||||
<span class="lineno"> 278 </span>reverseA :: Animation -> Animation
|
||||
<span class="lineno"> 279 </span><span class="decl"><span class="istickedoff">reverseA = signalA reverseS</span></span>
|
||||
<span class="lineno"> 280 </span>
|
||||
<span class="lineno"> 281 </span>-- | Play animation before playing it again in reverse. Duration is twice
|
||||
<span class="lineno"> 282 </span>-- the duration of the input.
|
||||
<span class="lineno"> 283 </span>--
|
||||
<span class="lineno"> 284 </span>-- Example:
|
||||
<span class="lineno"> 285 </span>--
|
||||
<span class="lineno"> 286 </span>-- > playThenReverseA drawCircle
|
||||
<span class="lineno"> 287 </span>--
|
||||
<span class="lineno"> 288 </span>-- <<docs/gifs/doc_playThenReverseA.gif>>
|
||||
<span class="lineno"> 289 </span>playThenReverseA :: Animation -> Animation
|
||||
<span class="lineno"> 290 </span><span class="decl"><span class="istickedoff">playThenReverseA a = a `seqA` reverseA a</span></span>
|
||||
<span class="lineno"> 291 </span>
|
||||
<span class="lineno"> 292 </span>-- | Loop animation @n@ number of times. This number may be fractional and it
|
||||
<span class="lineno"> 293 </span>-- may be less than 1. It must be greater than or equal to 0, though.
|
||||
<span class="lineno"> 294 </span>-- New duration is @n*duration input@.
|
||||
<span class="lineno"> 295 </span>--
|
||||
<span class="lineno"> 296 </span>-- Example:
|
||||
<span class="lineno"> 297 </span>--
|
||||
<span class="lineno"> 298 </span>-- > repeatA 1.5 drawCircle
|
||||
<span class="lineno"> 299 </span>--
|
||||
<span class="lineno"> 300 </span>-- <<docs/gifs/doc_repeatA.gif>>
|
||||
<span class="lineno"> 301 </span>repeatA :: Double -> Animation -> Animation
|
||||
<span class="lineno"> 302 </span><span class="decl"><span class="istickedoff">repeatA n (Animation d f) = Animation (d*n) $ \t -></span>
|
||||
<span class="lineno"> 303 </span><span class="spaces"> </span><span class="istickedoff">f ((t*n) `mod'` 1)</span></span>
|
||||
<span class="lineno"> 304 </span>
|
||||
<span class="lineno"> 305 </span>
|
||||
<span class="lineno"> 306 </span>-- | @freezeAtPercentage time animation@ creates an animation consisting of stationary frame,
|
||||
<span class="lineno"> 307 </span>-- that would be displayed in the provided @animation@ at given @time@.
|
||||
<span class="lineno"> 308 </span>-- The duration of the new animation is the same as the duration of provided @animation@.
|
||||
<span class="lineno"> 309 </span>freezeAtPercentage :: Time -- ^ value between 0 and 1. The frame displayed at this point in the original animation will be displayed for the duration of the new animation
|
||||
<span class="lineno"> 310 </span> -> Animation -- ^ original animation, from which the frame will be taken
|
||||
<span class="lineno"> 311 </span> -> Animation -- ^ new animation consisting of static frame displayed for the duration of the original animation
|
||||
<span class="lineno"> 312 </span><span class="decl"><span class="nottickedoff">freezeAtPercentage frac (Animation d genFrame) =</span>
|
||||
<span class="lineno"> 313 </span><span class="spaces"> </span><span class="nottickedoff">Animation d $ const $ genFrame frac</span></span>
|
||||
<span class="lineno"> 314 </span>
|
||||
<span class="lineno"> 315 </span>-- | Overlay animation on top of static SVG image.
|
||||
<span class="lineno"> 316 </span>--
|
||||
<span class="lineno"> 317 </span>-- Example:
|
||||
<span class="lineno"> 318 </span>--
|
||||
<span class="lineno"> 319 </span>-- > addStatic (mkBackground "lightblue") drawCircle
|
||||
<span class="lineno"> 320 </span>--
|
||||
<span class="lineno"> 321 </span>-- <<docs/gifs/doc_addStatic.gif>>
|
||||
<span class="lineno"> 322 </span>addStatic :: SVG -> Animation -> Animation
|
||||
<span class="lineno"> 323 </span><span class="decl"><span class="istickedoff">addStatic static = mapA (\frame -> mkGroup [static, frame])</span></span>
|
||||
<span class="lineno"> 324 </span>
|
||||
<span class="lineno"> 325 </span>-- | Modify the time component of an animation. Animation duration is unchanged.
|
||||
<span class="lineno"> 326 </span>--
|
||||
<span class="lineno"> 327 </span>-- Example:
|
||||
<span class="lineno"> 328 </span>--
|
||||
<span class="lineno"> 329 </span>-- > signalA (fromToS 0.25 0.75) drawCircle
|
||||
<span class="lineno"> 330 </span>--
|
||||
<span class="lineno"> 331 </span>-- <<docs/gifs/doc_signalA.gif>>
|
||||
<span class="lineno"> 332 </span>signalA :: Signal -> Animation -> Animation
|
||||
<span class="lineno"> 333 </span><span class="decl"><span class="istickedoff">signalA fn (Animation d gen) = Animation d $ gen . fn</span></span>
|
||||
<span class="lineno"> 334 </span>
|
||||
<span class="lineno"> 335 </span>-- | @takeA duration animation@ creates a new animation consisting of initial segment of
|
||||
<span class="lineno"> 336 </span>-- @animation@ of given @duration@, played at the same rate as the original animation.
|
||||
<span class="lineno"> 337 </span>--
|
||||
<span class="lineno"> 338 </span>-- The @duration@ parameter is clamped to be between 0 and @animation@'s duration.
|
||||
<span class="lineno"> 339 </span>-- New animation duration is equal to (eventually clamped) @duration@.
|
||||
<span class="lineno"> 340 </span>takeA :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 341 </span><span class="decl"><span class="istickedoff">takeA len (Animation d gen) = Animation len' $ \t -></span>
|
||||
<span class="lineno"> 342 </span><span class="spaces"> </span><span class="istickedoff">gen (t * len'/d)</span>
|
||||
<span class="lineno"> 343 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 344 </span><span class="spaces"> </span><span class="istickedoff">len' = clamp 0 d len</span></span>
|
||||
<span class="lineno"> 345 </span>
|
||||
<span class="lineno"> 346 </span>-- | @dropA duration animation@ creates a new animation by dropping initial segment
|
||||
<span class="lineno"> 347 </span>-- of length @duration@ from the provided @animation@, played at the same rate as the original animation.
|
||||
<span class="lineno"> 348 </span>--
|
||||
<span class="lineno"> 349 </span>-- The @duration@ parameter is clamped to be between 0 and @animation@'s duration.
|
||||
<span class="lineno"> 350 </span>-- The duration of the resulting animation is duration of provided @animation@ minus (eventually clamped) @duration@.
|
||||
<span class="lineno"> 351 </span>dropA :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 352 </span><span class="decl"><span class="istickedoff">dropA len (Animation d gen) = Animation len' $ \t -></span>
|
||||
<span class="lineno"> 353 </span><span class="spaces"> </span><span class="istickedoff">gen (t * len'/d + len/d)</span>
|
||||
<span class="lineno"> 354 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 355 </span><span class="spaces"> </span><span class="istickedoff">len' = d - clamp 0 d len</span></span>
|
||||
<span class="lineno"> 356 </span>
|
||||
<span class="lineno"> 357 </span>lastA :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 358 </span><span class="decl"><span class="istickedoff">lastA len a = dropA (duration a - len) a</span></span>
|
||||
<span class="lineno"> 219 </span>mapA :: (SVG -> SVG) -> Animation -> Animation
|
||||
<span class="lineno"> 220 </span><span class="decl"><span class="istickedoff">mapA fn (Animation d f) = Animation d (fn . f)</span></span>
|
||||
<span class="lineno"> 221 </span>
|
||||
<span class="lineno"> 222 </span>-- | Freeze the last frame for @t@ seconds at the end of the animation.
|
||||
<span class="lineno"> 223 </span>--
|
||||
<span class="lineno"> 224 </span>-- Example:
|
||||
<span class="lineno"> 225 </span>--
|
||||
<span class="lineno"> 226 </span>-- > pauseAtEnd 1 drawProgress
|
||||
<span class="lineno"> 227 </span>--
|
||||
<span class="lineno"> 228 </span>-- <<docs/gifs/doc_pauseAtEnd.gif>>
|
||||
<span class="lineno"> 229 </span>pauseAtEnd :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 230 </span><span class="decl"><span class="istickedoff">pauseAtEnd t a = a `andThen` pause t</span></span>
|
||||
<span class="lineno"> 231 </span>
|
||||
<span class="lineno"> 232 </span>-- | Freeze the first frame for @t@ seconds at the beginning of the animation.
|
||||
<span class="lineno"> 233 </span>--
|
||||
<span class="lineno"> 234 </span>-- Example:
|
||||
<span class="lineno"> 235 </span>--
|
||||
<span class="lineno"> 236 </span>-- > pauseAtBeginning 1 drawProgress
|
||||
<span class="lineno"> 237 </span>--
|
||||
<span class="lineno"> 238 </span>-- <<docs/gifs/doc_pauseAtBeginning.gif>>
|
||||
<span class="lineno"> 239 </span>pauseAtBeginning :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 240 </span><span class="decl"><span class="istickedoff">pauseAtBeginning t a =</span>
|
||||
<span class="lineno"> 241 </span><span class="spaces"> </span><span class="istickedoff">Animation t (freezeFrame 0 a) `seqA` a</span></span>
|
||||
<span class="lineno"> 242 </span>
|
||||
<span class="lineno"> 243 </span>-- | Freeze the first and the last frame of the animation for a specified duration.
|
||||
<span class="lineno"> 244 </span>--
|
||||
<span class="lineno"> 245 </span>-- Example:
|
||||
<span class="lineno"> 246 </span>--
|
||||
<span class="lineno"> 247 </span>-- > pauseAround 1 1 drawProgress
|
||||
<span class="lineno"> 248 </span>--
|
||||
<span class="lineno"> 249 </span>-- <<docs/gifs/doc_pauseAround.gif>>
|
||||
<span class="lineno"> 250 </span>pauseAround :: Duration -> Duration -> Animation -> Animation
|
||||
<span class="lineno"> 251 </span><span class="decl"><span class="istickedoff">pauseAround start end = pauseAtEnd end . pauseAtBeginning start</span></span>
|
||||
<span class="lineno"> 252 </span>
|
||||
<span class="lineno"> 253 </span>-- XXX: Rename to 'setDurationFreeze'. Add 'setDurationDrop' and
|
||||
<span class="lineno"> 254 </span>-- 'setDurationLoop'.
|
||||
<span class="lineno"> 255 </span>pauseUntil :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 256 </span><span class="decl"><span class="nottickedoff">pauseUntil d a = pauseAtEnd (d-duration a) a</span></span>
|
||||
<span class="lineno"> 257 </span>
|
||||
<span class="lineno"> 258 </span>-- Freeze frame at time @t@.
|
||||
<span class="lineno"> 259 </span>freezeFrame :: Time -> Animation -> (Time -> SVG)
|
||||
<span class="lineno"> 260 </span><span class="decl"><span class="istickedoff">freezeFrame t (Animation d f) = const $ f (t/d)</span></span>
|
||||
<span class="lineno"> 261 </span>
|
||||
<span class="lineno"> 262 </span>-- | Change the duration of an animation. Animates are stretched or squished
|
||||
<span class="lineno"> 263 </span>-- (rather than truncated) to fit the new duration.
|
||||
<span class="lineno"> 264 </span>adjustDuration :: (Duration -> Duration) -> Animation -> Animation
|
||||
<span class="lineno"> 265 </span><span class="decl"><span class="istickedoff">adjustDuration fn (Animation d gen) =</span>
|
||||
<span class="lineno"> 266 </span><span class="spaces"> </span><span class="istickedoff">Animation (fn d) gen</span></span>
|
||||
<span class="lineno"> 267 </span>
|
||||
<span class="lineno"> 268 </span>-- | Set the duration of an animation by adjusting its playback rate. The
|
||||
<span class="lineno"> 269 </span>-- animation is still played from start to finish without being cropped.
|
||||
<span class="lineno"> 270 </span>setDuration :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 271 </span><span class="decl"><span class="nottickedoff">setDuration newD = adjustDuration (const newD)</span></span>
|
||||
<span class="lineno"> 272 </span>
|
||||
<span class="lineno"> 273 </span>-- | Play an animation in reverse. Duration remains unchanged. Shorthand for:
|
||||
<span class="lineno"> 274 </span>-- @'signalA' 'reverseS'@.
|
||||
<span class="lineno"> 275 </span>--
|
||||
<span class="lineno"> 276 </span>-- Example:
|
||||
<span class="lineno"> 277 </span>--
|
||||
<span class="lineno"> 278 </span>-- > reverseA drawCircle
|
||||
<span class="lineno"> 279 </span>--
|
||||
<span class="lineno"> 280 </span>-- <<docs/gifs/doc_reverseA.gif>>
|
||||
<span class="lineno"> 281 </span>reverseA :: Animation -> Animation
|
||||
<span class="lineno"> 282 </span><span class="decl"><span class="istickedoff">reverseA = signalA reverseS</span></span>
|
||||
<span class="lineno"> 283 </span>
|
||||
<span class="lineno"> 284 </span>-- | Play animation before playing it again in reverse. Duration is twice
|
||||
<span class="lineno"> 285 </span>-- the duration of the input.
|
||||
<span class="lineno"> 286 </span>--
|
||||
<span class="lineno"> 287 </span>-- Example:
|
||||
<span class="lineno"> 288 </span>--
|
||||
<span class="lineno"> 289 </span>-- > playThenReverseA drawCircle
|
||||
<span class="lineno"> 290 </span>--
|
||||
<span class="lineno"> 291 </span>-- <<docs/gifs/doc_playThenReverseA.gif>>
|
||||
<span class="lineno"> 292 </span>playThenReverseA :: Animation -> Animation
|
||||
<span class="lineno"> 293 </span><span class="decl"><span class="istickedoff">playThenReverseA a = a `seqA` reverseA a</span></span>
|
||||
<span class="lineno"> 294 </span>
|
||||
<span class="lineno"> 295 </span>-- | Loop animation @n@ number of times. This number may be fractional and it
|
||||
<span class="lineno"> 296 </span>-- may be less than 1. It must be greater than or equal to 0, though.
|
||||
<span class="lineno"> 297 </span>-- New duration is @n*duration input@.
|
||||
<span class="lineno"> 298 </span>--
|
||||
<span class="lineno"> 299 </span>-- Example:
|
||||
<span class="lineno"> 300 </span>--
|
||||
<span class="lineno"> 301 </span>-- > repeatA 1.5 drawCircle
|
||||
<span class="lineno"> 302 </span>--
|
||||
<span class="lineno"> 303 </span>-- <<docs/gifs/doc_repeatA.gif>>
|
||||
<span class="lineno"> 304 </span>repeatA :: Double -> Animation -> Animation
|
||||
<span class="lineno"> 305 </span><span class="decl"><span class="istickedoff">repeatA n (Animation d f) = Animation (d*n) $ \t -></span>
|
||||
<span class="lineno"> 306 </span><span class="spaces"> </span><span class="istickedoff">f ((t*n) `mod'` 1)</span></span>
|
||||
<span class="lineno"> 307 </span>
|
||||
<span class="lineno"> 308 </span>
|
||||
<span class="lineno"> 309 </span>-- | @freezeAtPercentage time animation@ creates an animation consisting of stationary frame,
|
||||
<span class="lineno"> 310 </span>-- that would be displayed in the provided @animation@ at given @time@.
|
||||
<span class="lineno"> 311 </span>-- The duration of the new animation is the same as the duration of provided @animation@.
|
||||
<span class="lineno"> 312 </span>freezeAtPercentage :: Time -- ^ value between 0 and 1. The frame displayed at this point in the original animation will be displayed for the duration of the new animation
|
||||
<span class="lineno"> 313 </span> -> Animation -- ^ original animation, from which the frame will be taken
|
||||
<span class="lineno"> 314 </span> -> Animation -- ^ new animation consisting of static frame displayed for the duration of the original animation
|
||||
<span class="lineno"> 315 </span><span class="decl"><span class="nottickedoff">freezeAtPercentage frac (Animation d genFrame) =</span>
|
||||
<span class="lineno"> 316 </span><span class="spaces"> </span><span class="nottickedoff">Animation d $ const $ genFrame frac</span></span>
|
||||
<span class="lineno"> 317 </span>
|
||||
<span class="lineno"> 318 </span>-- | Overlay animation on top of static SVG image.
|
||||
<span class="lineno"> 319 </span>--
|
||||
<span class="lineno"> 320 </span>-- Example:
|
||||
<span class="lineno"> 321 </span>--
|
||||
<span class="lineno"> 322 </span>-- > addStatic (mkBackground "lightblue") drawCircle
|
||||
<span class="lineno"> 323 </span>--
|
||||
<span class="lineno"> 324 </span>-- <<docs/gifs/doc_addStatic.gif>>
|
||||
<span class="lineno"> 325 </span>addStatic :: SVG -> Animation -> Animation
|
||||
<span class="lineno"> 326 </span><span class="decl"><span class="istickedoff">addStatic static = mapA (\frame -> mkGroup [static, frame])</span></span>
|
||||
<span class="lineno"> 327 </span>
|
||||
<span class="lineno"> 328 </span>-- | Modify the time component of an animation. Animation duration is unchanged.
|
||||
<span class="lineno"> 329 </span>--
|
||||
<span class="lineno"> 330 </span>-- Example:
|
||||
<span class="lineno"> 331 </span>--
|
||||
<span class="lineno"> 332 </span>-- > signalA (fromToS 0.25 0.75) drawCircle
|
||||
<span class="lineno"> 333 </span>--
|
||||
<span class="lineno"> 334 </span>-- <<docs/gifs/doc_signalA.gif>>
|
||||
<span class="lineno"> 335 </span>signalA :: Signal -> Animation -> Animation
|
||||
<span class="lineno"> 336 </span><span class="decl"><span class="istickedoff">signalA fn (Animation d gen) = Animation d $ gen . fn</span></span>
|
||||
<span class="lineno"> 337 </span>
|
||||
<span class="lineno"> 338 </span>-- | @takeA duration animation@ creates a new animation consisting of initial segment of
|
||||
<span class="lineno"> 339 </span>-- @animation@ of given @duration@, played at the same rate as the original animation.
|
||||
<span class="lineno"> 340 </span>--
|
||||
<span class="lineno"> 341 </span>-- The @duration@ parameter is clamped to be between 0 and @animation@'s duration.
|
||||
<span class="lineno"> 342 </span>-- New animation duration is equal to (eventually clamped) @duration@.
|
||||
<span class="lineno"> 343 </span>takeA :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 344 </span><span class="decl"><span class="istickedoff">takeA len (Animation d gen) = Animation len' $ \t -></span>
|
||||
<span class="lineno"> 345 </span><span class="spaces"> </span><span class="istickedoff">gen (t * len'/d)</span>
|
||||
<span class="lineno"> 346 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 347 </span><span class="spaces"> </span><span class="istickedoff">len' = clamp 0 d len</span></span>
|
||||
<span class="lineno"> 348 </span>
|
||||
<span class="lineno"> 349 </span>-- | @dropA duration animation@ creates a new animation by dropping initial segment
|
||||
<span class="lineno"> 350 </span>-- of length @duration@ from the provided @animation@, played at the same rate as the original animation.
|
||||
<span class="lineno"> 351 </span>--
|
||||
<span class="lineno"> 352 </span>-- The @duration@ parameter is clamped to be between 0 and @animation@'s duration.
|
||||
<span class="lineno"> 353 </span>-- The duration of the resulting animation is duration of provided @animation@ minus (eventually clamped) @duration@.
|
||||
<span class="lineno"> 354 </span>dropA :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 355 </span><span class="decl"><span class="istickedoff">dropA len (Animation d gen) = Animation len' $ \t -></span>
|
||||
<span class="lineno"> 356 </span><span class="spaces"> </span><span class="istickedoff">gen (t * len'/d + len/d)</span>
|
||||
<span class="lineno"> 357 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 358 </span><span class="spaces"> </span><span class="istickedoff">len' = d - clamp 0 d len</span></span>
|
||||
<span class="lineno"> 359 </span>
|
||||
<span class="lineno"> 360 </span>clamp :: Double -> Double -> Double -> Double
|
||||
<span class="lineno"> 361 </span><span class="decl"><span class="istickedoff">clamp a b number</span>
|
||||
<span class="lineno"> 362 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlytrue">a < b</span> = max a (min b number)</span>
|
||||
<span class="lineno"> 363 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span> = <span class="nottickedoff">max b (min a number)</span></span></span>
|
||||
<span class="lineno"> 364 </span>
|
||||
<span class="lineno"> 365 </span>(#) :: a -> (a -> b) -> b
|
||||
<span class="lineno"> 366 </span><span class="decl"><span class="nottickedoff">o # f = f o</span></span>
|
||||
<span class="lineno"> 367 </span>
|
||||
<span class="lineno"> 368 </span>getAnimationFrame :: Sync -> Animation -> Time -> Duration -> SVG
|
||||
<span class="lineno"> 369 </span><span class="decl"><span class="istickedoff">getAnimationFrame sync (Animation aDur aGen) t d =</span>
|
||||
<span class="lineno"> 370 </span><span class="spaces"> </span><span class="istickedoff">case sync of</span>
|
||||
<span class="lineno"> 371 </span><span class="spaces"> </span><span class="istickedoff">SyncStretch -> aGen (t/d)</span>
|
||||
<span class="lineno"> 372 </span><span class="spaces"> </span><span class="istickedoff">SyncLoop -> <span class="nottickedoff">aGen (takeFrac $ t/aDur)</span></span>
|
||||
<span class="lineno"> 373 </span><span class="spaces"> </span><span class="istickedoff">SyncDrop -> <span class="nottickedoff">if t > aDur then None else aGen (t/aDur)</span></span>
|
||||
<span class="lineno"> 374 </span><span class="spaces"> </span><span class="istickedoff">SyncFreeze -> aGen (min 1 $ t/aDur)</span>
|
||||
<span class="lineno"> 375 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 376 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">takeFrac f = snd (properFraction f :: (Int, Double))</span></span></span>
|
||||
<span class="lineno"> 377 </span>
|
||||
<span class="lineno"> 378 </span>data Sync
|
||||
<span class="lineno"> 379 </span> = SyncStretch
|
||||
<span class="lineno"> 380 </span> | SyncLoop
|
||||
<span class="lineno"> 381 </span> | SyncDrop
|
||||
<span class="lineno"> 382 </span> | SyncFreeze
|
||||
<span class="lineno"> 360 </span>-- | @lastA duration animation@ return the last @duration@ seconds of the animation.
|
||||
<span class="lineno"> 361 </span>lastA :: Duration -> Animation -> Animation
|
||||
<span class="lineno"> 362 </span><span class="decl"><span class="istickedoff">lastA len a = dropA (duration a - len) a</span></span>
|
||||
<span class="lineno"> 363 </span>
|
||||
<span class="lineno"> 364 </span>clamp :: Double -> Double -> Double -> Double
|
||||
<span class="lineno"> 365 </span><span class="decl"><span class="istickedoff">clamp a b number</span>
|
||||
<span class="lineno"> 366 </span><span class="spaces"> </span><span class="istickedoff">| <span class="tickonlytrue">a < b</span> = max a (min b number)</span>
|
||||
<span class="lineno"> 367 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span> = <span class="nottickedoff">max b (min a number)</span></span></span>
|
||||
<span class="lineno"> 368 </span>
|
||||
<span class="lineno"> 369 </span>-- (#) :: a -> (a -> b) -> b
|
||||
<span class="lineno"> 370 </span>-- o # f = f o
|
||||
<span class="lineno"> 371 </span>
|
||||
<span class="lineno"> 372 </span>-- | Ask for an animation frame using a given synchronization policy.
|
||||
<span class="lineno"> 373 </span>getAnimationFrame :: Sync -> Animation -> Time -> Duration -> SVG
|
||||
<span class="lineno"> 374 </span><span class="decl"><span class="istickedoff">getAnimationFrame sync (Animation aDur aGen) t d =</span>
|
||||
<span class="lineno"> 375 </span><span class="spaces"> </span><span class="istickedoff">case sync of</span>
|
||||
<span class="lineno"> 376 </span><span class="spaces"> </span><span class="istickedoff">SyncStretch -> aGen (t/d)</span>
|
||||
<span class="lineno"> 377 </span><span class="spaces"> </span><span class="istickedoff">SyncLoop -> <span class="nottickedoff">aGen (takeFrac $ t/aDur)</span></span>
|
||||
<span class="lineno"> 378 </span><span class="spaces"> </span><span class="istickedoff">SyncDrop -> <span class="nottickedoff">if t > aDur then None else aGen (t/aDur)</span></span>
|
||||
<span class="lineno"> 379 </span><span class="spaces"> </span><span class="istickedoff">SyncFreeze -> aGen (min 1 $ t/aDur)</span>
|
||||
<span class="lineno"> 380 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 381 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">takeFrac f = snd (properFraction f :: (Int, Double))</span></span></span>
|
||||
<span class="lineno"> 382 </span>
|
||||
<span class="lineno"> 383 </span>-- | Animation synchronization policies.
|
||||
<span class="lineno"> 384 </span>data Sync
|
||||
<span class="lineno"> 385 </span> = SyncStretch
|
||||
<span class="lineno"> 386 </span> | SyncLoop
|
||||
<span class="lineno"> 387 </span> | SyncDrop
|
||||
<span class="lineno"> 388 </span> | SyncFreeze
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
|
|
|
|||
|
|
@ -25,51 +25,54 @@ span.spaces { background: white }
|
|||
<span class="lineno"> 6 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 7 </span>import Codec.Picture
|
||||
<span class="lineno"> 8 </span>
|
||||
<span class="lineno"> 9 </span>docEnv :: Animation -> Animation
|
||||
<span class="lineno"> 10 </span><span class="decl"><span class="istickedoff">docEnv = mapA $ \svg -> mkGroup</span>
|
||||
<span class="lineno"> 11 </span><span class="spaces"> </span><span class="istickedoff">[ mkBackground "white"</span>
|
||||
<span class="lineno"> 12 </span><span class="spaces"> </span><span class="istickedoff">, withFillOpacity 0 $</span>
|
||||
<span class="lineno"> 13 </span><span class="spaces"> </span><span class="istickedoff">withStrokeWidth 0.1 $</span>
|
||||
<span class="lineno"> 14 </span><span class="spaces"> </span><span class="istickedoff">withStrokeColor "black" (mkGroup [svg]) ]</span></span>
|
||||
<span class="lineno"> 15 </span>
|
||||
<span class="lineno"> 16 </span>-- | <<docs/gifs/doc_drawBox.gif>>
|
||||
<span class="lineno"> 17 </span>drawBox :: Animation
|
||||
<span class="lineno"> 18 </span><span class="decl"><span class="istickedoff">drawBox = mkAnimation 2 $ \t -></span>
|
||||
<span class="lineno"> 19 </span><span class="spaces"> </span><span class="istickedoff">partialSvg t $ pathify $</span>
|
||||
<span class="lineno"> 20 </span><span class="spaces"> </span><span class="istickedoff">mkRect (screenWidth/2) (screenHeight/2)</span></span>
|
||||
<span class="lineno"> 21 </span>
|
||||
<span class="lineno"> 22 </span>-- | <<docs/gifs/doc_drawCircle.gif>>
|
||||
<span class="lineno"> 23 </span>drawCircle :: Animation
|
||||
<span class="lineno"> 24 </span><span class="decl"><span class="istickedoff">drawCircle = mkAnimation 2 $ \t -></span>
|
||||
<span class="lineno"> 25 </span><span class="spaces"> </span><span class="istickedoff">partialSvg t $ pathify $</span>
|
||||
<span class="lineno"> 26 </span><span class="spaces"> </span><span class="istickedoff">mkCircle (screenHeight/3)</span></span>
|
||||
<span class="lineno"> 27 </span>
|
||||
<span class="lineno"> 28 </span>drawBall :: Animation
|
||||
<span class="lineno"> 29 </span><span class="decl"><span class="nottickedoff">drawBall = mkAnimation 2 $ \t -></span>
|
||||
<span class="lineno"> 30 </span><span class="spaces"> </span><span class="nottickedoff">scale t $ withFillOpacity 1 $ withFillColor "red" $</span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="nottickedoff">mkCircle (screenHeight/3)</span></span>
|
||||
<span class="lineno"> 32 </span>
|
||||
<span class="lineno"> 33 </span>-- | <<docs/gifs/doc_drawProgress.gif>>
|
||||
<span class="lineno"> 34 </span>drawProgress :: Animation
|
||||
<span class="lineno"> 35 </span><span class="decl"><span class="istickedoff">drawProgress = mkAnimation 2 $ \t -></span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="istickedoff">mkGroup</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="istickedoff">[ mkLine (-screenWidth/2*widthP,0)</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="istickedoff">(screenWidth/2*widthP,0)</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="istickedoff">, translate (-screenWidth/2*widthP + screenWidth*widthP*t) 0 $</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="istickedoff">withFillOpacity 1 $ mkCircle 0.5 ]</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="istickedoff">widthP = 0.8</span></span>
|
||||
<span class="lineno"> 43 </span>
|
||||
<span class="lineno"> 44 </span>showColorMap :: (Double -> PixelRGB8) -> SVG
|
||||
<span class="lineno"> 45 </span><span class="decl"><span class="istickedoff">showColorMap f = center $ scaleToSize screenWidth screenHeight $ embedImage img</span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="istickedoff">width = 256</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="istickedoff">height = 1</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="istickedoff">img = generateImage pixelRenderer width height</span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="istickedoff">pixelRenderer x _y = f (fromIntegral x / fromIntegral (width-1))</span></span>
|
||||
<span class="lineno"> 51 </span>
|
||||
<span class="lineno"> 52 </span>rtfdBackgroundColor :: PixelRGBA8
|
||||
<span class="lineno"> 53 </span><span class="decl"><span class="istickedoff">rtfdBackgroundColor = PixelRGBA8 252 252 252 0xFF</span></span>
|
||||
<span class="lineno"> 9 </span>-- | Default environment for API documentation GIFs.
|
||||
<span class="lineno"> 10 </span>docEnv :: Animation -> Animation
|
||||
<span class="lineno"> 11 </span><span class="decl"><span class="istickedoff">docEnv = mapA $ \svg -> mkGroup</span>
|
||||
<span class="lineno"> 12 </span><span class="spaces"> </span><span class="istickedoff">[ mkBackground "white"</span>
|
||||
<span class="lineno"> 13 </span><span class="spaces"> </span><span class="istickedoff">, withFillOpacity 0 $</span>
|
||||
<span class="lineno"> 14 </span><span class="spaces"> </span><span class="istickedoff">withStrokeWidth 0.1 $</span>
|
||||
<span class="lineno"> 15 </span><span class="spaces"> </span><span class="istickedoff">withStrokeColor "black" (mkGroup [svg]) ]</span></span>
|
||||
<span class="lineno"> 16 </span>
|
||||
<span class="lineno"> 17 </span>-- | <<docs/gifs/doc_drawBox.gif>>
|
||||
<span class="lineno"> 18 </span>drawBox :: Animation
|
||||
<span class="lineno"> 19 </span><span class="decl"><span class="istickedoff">drawBox = mkAnimation 2 $ \t -></span>
|
||||
<span class="lineno"> 20 </span><span class="spaces"> </span><span class="istickedoff">partialSvg t $ pathify $</span>
|
||||
<span class="lineno"> 21 </span><span class="spaces"> </span><span class="istickedoff">mkRect (screenWidth/2) (screenHeight/2)</span></span>
|
||||
<span class="lineno"> 22 </span>
|
||||
<span class="lineno"> 23 </span>-- | <<docs/gifs/doc_drawCircle.gif>>
|
||||
<span class="lineno"> 24 </span>drawCircle :: Animation
|
||||
<span class="lineno"> 25 </span><span class="decl"><span class="istickedoff">drawCircle = mkAnimation 2 $ \t -></span>
|
||||
<span class="lineno"> 26 </span><span class="spaces"> </span><span class="istickedoff">partialSvg t $ pathify $</span>
|
||||
<span class="lineno"> 27 </span><span class="spaces"> </span><span class="istickedoff">mkCircle (screenHeight/3)</span></span>
|
||||
<span class="lineno"> 28 </span>
|
||||
<span class="lineno"> 29 </span>drawBall :: Animation
|
||||
<span class="lineno"> 30 </span><span class="decl"><span class="nottickedoff">drawBall = mkAnimation 2 $ \t -></span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="nottickedoff">scale t $ withFillOpacity 1 $ withFillColor "red" $</span>
|
||||
<span class="lineno"> 32 </span><span class="spaces"> </span><span class="nottickedoff">mkCircle (screenHeight/3)</span></span>
|
||||
<span class="lineno"> 33 </span>
|
||||
<span class="lineno"> 34 </span>-- | <<docs/gifs/doc_drawProgress.gif>>
|
||||
<span class="lineno"> 35 </span>drawProgress :: Animation
|
||||
<span class="lineno"> 36 </span><span class="decl"><span class="istickedoff">drawProgress = mkAnimation 2 $ \t -></span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="istickedoff">mkGroup</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="istickedoff">[ mkLine (-screenWidth/2*widthP,0)</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="istickedoff">(screenWidth/2*widthP,0)</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="istickedoff">, translate (-screenWidth/2*widthP + screenWidth*widthP*t) 0 $</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="istickedoff">withFillOpacity 1 $ mkCircle 0.5 ]</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 43 </span><span class="spaces"> </span><span class="istickedoff">widthP = 0.8</span></span>
|
||||
<span class="lineno"> 44 </span>
|
||||
<span class="lineno"> 45 </span>-- | Render a full-screen view of a color-map.
|
||||
<span class="lineno"> 46 </span>showColorMap :: (Double -> PixelRGB8) -> SVG
|
||||
<span class="lineno"> 47 </span><span class="decl"><span class="istickedoff">showColorMap f = center $ scaleToSize screenWidth screenHeight $ embedImage img</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="istickedoff">width = 256</span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="istickedoff">height = 1</span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="istickedoff">img = generateImage pixelRenderer width height</span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="istickedoff">pixelRenderer x _y = f (fromIntegral x / fromIntegral (width-1))</span></span>
|
||||
<span class="lineno"> 53 </span>
|
||||
<span class="lineno"> 54 </span>-- | Default background color for videos on reanimate.rtfd.io
|
||||
<span class="lineno"> 55 </span>rtfdBackgroundColor :: PixelRGBA8
|
||||
<span class="lineno"> 56 </span><span class="decl"><span class="istickedoff">rtfdBackgroundColor = PixelRGBA8 252 252 252 0xFF</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
|
|
|
|||
|
|
@ -17,113 +17,124 @@ span.spaces { background: white }
|
|||
<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.Ease
|
||||
<span class="lineno"> 2 </span> ( Signal
|
||||
<span class="lineno"> 3 </span> , constantS
|
||||
<span class="lineno"> 4 </span> , fromToS
|
||||
<span class="lineno"> 5 </span> , reverseS
|
||||
<span class="lineno"> 6 </span> , curveS
|
||||
<span class="lineno"> 7 </span> , powerS
|
||||
<span class="lineno"> 8 </span> , bellS
|
||||
<span class="lineno"> 9 </span> , oscillateS
|
||||
<span class="lineno"> 10 </span> , fromListS
|
||||
<span class="lineno"> 11 </span> , cubicBezierS
|
||||
<span class="lineno"> 12 </span> ) where
|
||||
<span class="lineno"> 13 </span>
|
||||
<span class="lineno"> 14 </span>-- | Signals are time-varying variables. Signals can be composed using function
|
||||
<span class="lineno"> 15 </span>-- composition.
|
||||
<span class="lineno"> 16 </span>type Signal = Double -> Double
|
||||
<span class="lineno"> 1 </span>{-|
|
||||
<span class="lineno"> 2 </span> Easing functions modify the rate of change in animations.
|
||||
<span class="lineno"> 3 </span> More examples can be seen here: <https://easings.net/>.
|
||||
<span class="lineno"> 4 </span>-}
|
||||
<span class="lineno"> 5 </span>module Reanimate.Ease
|
||||
<span class="lineno"> 6 </span> ( Signal
|
||||
<span class="lineno"> 7 </span> , constantS
|
||||
<span class="lineno"> 8 </span> , fromToS
|
||||
<span class="lineno"> 9 </span> , reverseS
|
||||
<span class="lineno"> 10 </span> , curveS
|
||||
<span class="lineno"> 11 </span> , powerS
|
||||
<span class="lineno"> 12 </span> , bellS
|
||||
<span class="lineno"> 13 </span> , oscillateS
|
||||
<span class="lineno"> 14 </span> , fromListS
|
||||
<span class="lineno"> 15 </span> , cubicBezierS
|
||||
<span class="lineno"> 16 </span> ) where
|
||||
<span class="lineno"> 17 </span>
|
||||
<span class="lineno"> 18 </span>fromListS :: [(Double, Signal)] -> Signal
|
||||
<span class="lineno"> 19 </span><span class="decl"><span class="nottickedoff">fromListS fns t = worker 0 fns</span>
|
||||
<span class="lineno"> 20 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 21 </span><span class="spaces"> </span><span class="nottickedoff">worker _ [] = 0</span>
|
||||
<span class="lineno"> 22 </span><span class="spaces"> </span><span class="nottickedoff">worker now [(len, fn)] = fn (min 1 ((t-now) / min (1-now) len))</span>
|
||||
<span class="lineno"> 23 </span><span class="spaces"> </span><span class="nottickedoff">worker now ((len, fn):rest)</span>
|
||||
<span class="lineno"> 24 </span><span class="spaces"> </span><span class="nottickedoff">| now+len < t = worker (now+len) rest</span>
|
||||
<span class="lineno"> 25 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = fn ((t-now) / len)</span></span>
|
||||
<span class="lineno"> 26 </span>
|
||||
<span class="lineno"> 27 </span>-- | Constant signal.
|
||||
<span class="lineno"> 28 </span>--
|
||||
<span class="lineno"> 29 </span>-- Example:
|
||||
<span class="lineno"> 30 </span>--
|
||||
<span class="lineno"> 31 </span>-- > signalA (constantS 0.5) drawProgress
|
||||
<span class="lineno"> 18 </span>-- | Signals are time-varying variables. Signals can be composed using function
|
||||
<span class="lineno"> 19 </span>-- composition.
|
||||
<span class="lineno"> 20 </span>type Signal = Double -> Double
|
||||
<span class="lineno"> 21 </span>
|
||||
<span class="lineno"> 22 </span>fromListS :: [(Double, Signal)] -> Signal
|
||||
<span class="lineno"> 23 </span><span class="decl"><span class="nottickedoff">fromListS fns t = worker 0 fns</span>
|
||||
<span class="lineno"> 24 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 25 </span><span class="spaces"> </span><span class="nottickedoff">worker _ [] = 0</span>
|
||||
<span class="lineno"> 26 </span><span class="spaces"> </span><span class="nottickedoff">worker now [(len, fn)] = fn (min 1 ((t-now) / min (1-now) len))</span>
|
||||
<span class="lineno"> 27 </span><span class="spaces"> </span><span class="nottickedoff">worker now ((len, fn):rest)</span>
|
||||
<span class="lineno"> 28 </span><span class="spaces"> </span><span class="nottickedoff">| now+len < t = worker (now+len) rest</span>
|
||||
<span class="lineno"> 29 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = fn ((t-now) / len)</span></span>
|
||||
<span class="lineno"> 30 </span>
|
||||
<span class="lineno"> 31 </span>-- | Constant signal.
|
||||
<span class="lineno"> 32 </span>--
|
||||
<span class="lineno"> 33 </span>-- <<docs/gifs/doc_constantS.gif>>
|
||||
<span class="lineno"> 34 </span>constantS :: Double -> Signal
|
||||
<span class="lineno"> 35 </span><span class="decl"><span class="istickedoff">constantS = const</span></span>
|
||||
<span class="lineno"> 36 </span>
|
||||
<span class="lineno"> 37 </span>-- | Signal with new starting and end values.
|
||||
<span class="lineno"> 38 </span>--
|
||||
<span class="lineno"> 39 </span>-- Example:
|
||||
<span class="lineno"> 40 </span>--
|
||||
<span class="lineno"> 41 </span>-- > signalA (fromToS 0.8 0.2) drawProgress
|
||||
<span class="lineno"> 33 </span>-- Example:
|
||||
<span class="lineno"> 34 </span>--
|
||||
<span class="lineno"> 35 </span>-- > signalA (constantS 0.5) drawProgress
|
||||
<span class="lineno"> 36 </span>--
|
||||
<span class="lineno"> 37 </span>-- <<docs/gifs/doc_constantS.gif>>
|
||||
<span class="lineno"> 38 </span>constantS :: Double -> Signal
|
||||
<span class="lineno"> 39 </span><span class="decl"><span class="istickedoff">constantS = const</span></span>
|
||||
<span class="lineno"> 40 </span>
|
||||
<span class="lineno"> 41 </span>-- | Signal with new starting and end values.
|
||||
<span class="lineno"> 42 </span>--
|
||||
<span class="lineno"> 43 </span>-- <<docs/gifs/doc_fromToS.gif>>
|
||||
<span class="lineno"> 44 </span>fromToS :: Double -> Double -> Signal
|
||||
<span class="lineno"> 45 </span><span class="decl"><span class="istickedoff">fromToS from to t = from + (to-from)*t</span></span>
|
||||
<span class="lineno"> 46 </span>
|
||||
<span class="lineno"> 47 </span>-- | Reverse signal order.
|
||||
<span class="lineno"> 48 </span>--
|
||||
<span class="lineno"> 49 </span>-- Example:
|
||||
<span class="lineno"> 50 </span>--
|
||||
<span class="lineno"> 51 </span>-- > signalA reverseS drawProgress
|
||||
<span class="lineno"> 43 </span>-- Example:
|
||||
<span class="lineno"> 44 </span>--
|
||||
<span class="lineno"> 45 </span>-- > signalA (fromToS 0.8 0.2) drawProgress
|
||||
<span class="lineno"> 46 </span>--
|
||||
<span class="lineno"> 47 </span>-- <<docs/gifs/doc_fromToS.gif>>
|
||||
<span class="lineno"> 48 </span>fromToS :: Double -> Double -> Signal
|
||||
<span class="lineno"> 49 </span><span class="decl"><span class="istickedoff">fromToS from to t = from + (to-from)*t</span></span>
|
||||
<span class="lineno"> 50 </span>
|
||||
<span class="lineno"> 51 </span>-- | Reverse signal order.
|
||||
<span class="lineno"> 52 </span>--
|
||||
<span class="lineno"> 53 </span>-- <<docs/gifs/doc_reverseS.gif>>
|
||||
<span class="lineno"> 54 </span>reverseS :: Signal
|
||||
<span class="lineno"> 55 </span><span class="decl"><span class="istickedoff">reverseS t = 1-t</span></span>
|
||||
<span class="lineno"> 56 </span>
|
||||
<span class="lineno"> 57 </span>-- | S-curve signal. Takes a steepness parameter. 2 is a good default.
|
||||
<span class="lineno"> 58 </span>--
|
||||
<span class="lineno"> 59 </span>-- Example:
|
||||
<span class="lineno"> 60 </span>--
|
||||
<span class="lineno"> 61 </span>-- > signalA (curveS 2) drawProgress
|
||||
<span class="lineno"> 53 </span>-- Example:
|
||||
<span class="lineno"> 54 </span>--
|
||||
<span class="lineno"> 55 </span>-- > signalA reverseS drawProgress
|
||||
<span class="lineno"> 56 </span>--
|
||||
<span class="lineno"> 57 </span>-- <<docs/gifs/doc_reverseS.gif>>
|
||||
<span class="lineno"> 58 </span>reverseS :: Signal
|
||||
<span class="lineno"> 59 </span><span class="decl"><span class="istickedoff">reverseS t = 1-t</span></span>
|
||||
<span class="lineno"> 60 </span>
|
||||
<span class="lineno"> 61 </span>-- | S-curve signal. Takes a steepness parameter. 2 is a good default.
|
||||
<span class="lineno"> 62 </span>--
|
||||
<span class="lineno"> 63 </span>-- <<docs/gifs/doc_curveS.gif>>
|
||||
<span class="lineno"> 64 </span>curveS :: Double -> Signal
|
||||
<span class="lineno"> 65 </span><span class="decl"><span class="istickedoff">curveS steepness s =</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="istickedoff">if s < 0.5</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="istickedoff">then 0.5 * (2*s)**steepness</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="istickedoff">else 1-0.5 * (2 - 2*s)**steepness</span></span>
|
||||
<span class="lineno"> 69 </span>
|
||||
<span class="lineno"> 70 </span>powerS :: Double -> Signal
|
||||
<span class="lineno"> 71 </span><span class="decl"><span class="nottickedoff">powerS steepness s = s**steepness</span></span>
|
||||
<span class="lineno"> 72 </span>
|
||||
<span class="lineno"> 73 </span>-- | Oscillate signal.
|
||||
<span class="lineno"> 74 </span>--
|
||||
<span class="lineno"> 75 </span>-- Example:
|
||||
<span class="lineno"> 76 </span>--
|
||||
<span class="lineno"> 77 </span>-- > signalA oscillateS drawProgress
|
||||
<span class="lineno"> 78 </span>--
|
||||
<span class="lineno"> 79 </span>-- <<docs/gifs/doc_oscillateS.gif>>
|
||||
<span class="lineno"> 80 </span>oscillateS :: Signal
|
||||
<span class="lineno"> 81 </span><span class="decl"><span class="istickedoff">oscillateS t =</span>
|
||||
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="istickedoff">if t < 1/2</span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="istickedoff">then t*2</span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="istickedoff">else 2-t*2</span></span>
|
||||
<span class="lineno"> 85 </span>
|
||||
<span class="lineno"> 86 </span>-- | Bell-curve signal. Takes a steepness parameter. 2 is a good default.
|
||||
<span class="lineno"> 63 </span>-- Example:
|
||||
<span class="lineno"> 64 </span>--
|
||||
<span class="lineno"> 65 </span>-- > signalA (curveS 2) drawProgress
|
||||
<span class="lineno"> 66 </span>--
|
||||
<span class="lineno"> 67 </span>-- <<docs/gifs/doc_curveS.gif>>
|
||||
<span class="lineno"> 68 </span>curveS :: Double -> Signal
|
||||
<span class="lineno"> 69 </span><span class="decl"><span class="istickedoff">curveS steepness s =</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="istickedoff">if s < 0.5</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="istickedoff">then 0.5 * (2*s)**steepness</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="istickedoff">else 1-0.5 * (2 - 2*s)**steepness</span></span>
|
||||
<span class="lineno"> 73 </span>
|
||||
<span class="lineno"> 74 </span>-- | Power curve signal. Takes a steepness parameter. 2 is a good default.
|
||||
<span class="lineno"> 75 </span>--
|
||||
<span class="lineno"> 76 </span>-- Example:
|
||||
<span class="lineno"> 77 </span>--
|
||||
<span class="lineno"> 78 </span>-- > signalA (powerS 2) drawProgress
|
||||
<span class="lineno"> 79 </span>--
|
||||
<span class="lineno"> 80 </span>-- <<docs/gifs/doc_powerS.gif>>
|
||||
<span class="lineno"> 81 </span>powerS :: Double -> Signal
|
||||
<span class="lineno"> 82 </span><span class="decl"><span class="nottickedoff">powerS steepness s = s**steepness</span></span>
|
||||
<span class="lineno"> 83 </span>
|
||||
<span class="lineno"> 84 </span>-- | Oscillate signal.
|
||||
<span class="lineno"> 85 </span>--
|
||||
<span class="lineno"> 86 </span>-- Example:
|
||||
<span class="lineno"> 87 </span>--
|
||||
<span class="lineno"> 88 </span>-- Example:
|
||||
<span class="lineno"> 88 </span>-- > signalA oscillateS drawProgress
|
||||
<span class="lineno"> 89 </span>--
|
||||
<span class="lineno"> 90 </span>-- > signalA (bellS 2) drawProgress
|
||||
<span class="lineno"> 91 </span>--
|
||||
<span class="lineno"> 92 </span>-- <<docs/gifs/doc_bellS.gif>>
|
||||
<span class="lineno"> 93 </span>bellS :: Double -> Signal
|
||||
<span class="lineno"> 94 </span><span class="decl"><span class="istickedoff">bellS steepness = curveS steepness . oscillateS</span></span>
|
||||
<span class="lineno"> 95 </span>
|
||||
<span class="lineno"> 96 </span>-- | Cubic Bezier signal. Gives you a fair amount of control over how the
|
||||
<span class="lineno"> 97 </span>-- signal will 'curve'.
|
||||
<span class="lineno"> 90 </span>-- <<docs/gifs/doc_oscillateS.gif>>
|
||||
<span class="lineno"> 91 </span>oscillateS :: Signal
|
||||
<span class="lineno"> 92 </span><span class="decl"><span class="istickedoff">oscillateS t =</span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="istickedoff">if t < 1/2</span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="istickedoff">then t*2</span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="istickedoff">else 2-t*2</span></span>
|
||||
<span class="lineno"> 96 </span>
|
||||
<span class="lineno"> 97 </span>-- | Bell-curve signal. Takes a steepness parameter. 2 is a good default.
|
||||
<span class="lineno"> 98 </span>--
|
||||
<span class="lineno"> 99 </span>-- Example:
|
||||
<span class="lineno"> 100 </span>--
|
||||
<span class="lineno"> 101 </span>-- > signalA (cubicBezierS (0.0, 0.8, 0.9, 1.0)) drawProgress
|
||||
<span class="lineno"> 101 </span>-- > signalA (bellS 2) drawProgress
|
||||
<span class="lineno"> 102 </span>--
|
||||
<span class="lineno"> 103 </span>-- <<docs/gifs/doc_cubicBezierS.gif>>
|
||||
<span class="lineno"> 104 </span>cubicBezierS :: (Double, Double, Double, Double) -> Signal
|
||||
<span class="lineno"> 105 </span><span class="decl"><span class="istickedoff">cubicBezierS (x1, x2, x3, x4) s = </span>
|
||||
<span class="lineno"> 106 </span><span class="spaces"> </span><span class="istickedoff">let ms = 1-s</span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="istickedoff">in x1*ms^(3::Int) + 3*x2*ms^(2::Int)*s + 3*x3*ms*s^(2::Int) + x4*s^(3::Int)</span></span>
|
||||
<span class="lineno"> 103 </span>-- <<docs/gifs/doc_bellS.gif>>
|
||||
<span class="lineno"> 104 </span>bellS :: Double -> Signal
|
||||
<span class="lineno"> 105 </span><span class="decl"><span class="istickedoff">bellS steepness = curveS steepness . oscillateS</span></span>
|
||||
<span class="lineno"> 106 </span>
|
||||
<span class="lineno"> 107 </span>-- | Cubic Bezier signal. Gives you a fair amount of control over how the
|
||||
<span class="lineno"> 108 </span>-- signal will 'curve'.
|
||||
<span class="lineno"> 109 </span>--
|
||||
<span class="lineno"> 110 </span>-- Example:
|
||||
<span class="lineno"> 111 </span>--
|
||||
<span class="lineno"> 112 </span>-- > signalA (cubicBezierS (0.0, 0.8, 0.9, 1.0)) drawProgress
|
||||
<span class="lineno"> 113 </span>--
|
||||
<span class="lineno"> 114 </span>-- <<docs/gifs/doc_cubicBezierS.gif>>
|
||||
<span class="lineno"> 115 </span>cubicBezierS :: (Double, Double, Double, Double) -> Signal
|
||||
<span class="lineno"> 116 </span><span class="decl"><span class="istickedoff">cubicBezierS (x1, x2, x3, x4) s = </span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff">let ms = 1-s</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="istickedoff">in x1*ms^(3::Int) + 3*x2*ms^(2::Int)*s + 3*x3*ms*s^(2::Int) + x4*s^(3::Int)</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
|
|
|
|||
|
|
@ -138,180 +138,189 @@ span.spaces { background: white }
|
|||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="nottickedoff">target = pRootDirectory </> encodeInt hashPath <.> takeExtension path</span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="nottickedoff">hashPath = hash path</span></span>
|
||||
<span class="lineno"> 121 </span>
|
||||
<span class="lineno"> 122 </span>cacheImage :: (PngSavable pixel, Hashable a) => a -> Image pixel -> FilePath
|
||||
<span class="lineno"> 123 </span><span class="decl"><span class="nottickedoff">cacheImage key gen = unsafePerformIO $ cacheFile template $ \path -></span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="nottickedoff">writePng path gen</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="nottickedoff">where template = encodeInt (hash key) <.> "png"</span></span>
|
||||
<span class="lineno"> 126 </span>
|
||||
<span class="lineno"> 127 </span>-- Warning: Caching svg elements with links to external objects does
|
||||
<span class="lineno"> 128 </span>-- not work. 2020-06-01
|
||||
<span class="lineno"> 129 </span>prerenderSvgFile :: Hashable a => a -> Width -> Height -> SVG -> FilePath
|
||||
<span class="lineno"> 130 </span><span class="decl"><span class="nottickedoff">prerenderSvgFile key width height svg =</span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="nottickedoff">unsafePerformIO $ cacheFile template $ \path -> do</span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="nottickedoff">let svgPath = replaceExtension path "svg"</span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="nottickedoff">writeFile svgPath rendered</span>
|
||||
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="nottickedoff">engine <- requireRaster pRaster</span>
|
||||
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="nottickedoff">applyRaster engine svgPath</span>
|
||||
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="nottickedoff">template = encodeInt (hash (key, width, height)) <.> "png"</span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="nottickedoff">rendered = renderSvg (Just $ Px $ fromIntegral width)</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="nottickedoff">(Just $ Px $ fromIntegral height)</span>
|
||||
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="nottickedoff">svg</span></span>
|
||||
<span class="lineno"> 141 </span>
|
||||
<span class="lineno"> 142 </span>prerenderSvg :: Hashable a => a -> SVG -> SVG
|
||||
<span class="lineno"> 143 </span><span class="decl"><span class="nottickedoff">prerenderSvg key =</span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="nottickedoff">mkImage screenWidth screenHeight . prerenderSvgFile key pWidth pHeight</span></span>
|
||||
<span class="lineno"> 122 </span>-- | Write in-memory image to cache file if (and only if) such cache file doesn't
|
||||
<span class="lineno"> 123 </span>-- already exist.
|
||||
<span class="lineno"> 124 </span>cacheImage :: (PngSavable pixel, Hashable a) => a -> Image pixel -> FilePath
|
||||
<span class="lineno"> 125 </span><span class="decl"><span class="nottickedoff">cacheImage key gen = unsafePerformIO $ cacheFile template $ \path -></span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="nottickedoff">writePng path gen</span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="nottickedoff">where template = encodeInt (hash key) <.> "png"</span></span>
|
||||
<span class="lineno"> 128 </span>
|
||||
<span class="lineno"> 129 </span>-- Warning: Caching svg elements with links to external objects does
|
||||
<span class="lineno"> 130 </span>-- not work. 2020-06-01
|
||||
<span class="lineno"> 131 </span>-- | Same as 'prerenderSvg' but returns the location of the rendered image
|
||||
<span class="lineno"> 132 </span>-- as a FilePath.
|
||||
<span class="lineno"> 133 </span>prerenderSvgFile :: Hashable a => a -> Width -> Height -> SVG -> FilePath
|
||||
<span class="lineno"> 134 </span><span class="decl"><span class="nottickedoff">prerenderSvgFile key width height svg =</span>
|
||||
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="nottickedoff">unsafePerformIO $ cacheFile template $ \path -> do</span>
|
||||
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="nottickedoff">let svgPath = replaceExtension path "svg"</span>
|
||||
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="nottickedoff">writeFile svgPath rendered</span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="nottickedoff">engine <- requireRaster pRaster</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="nottickedoff">applyRaster engine svgPath</span>
|
||||
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="nottickedoff">template = encodeInt (hash (key, width, height)) <.> "png"</span>
|
||||
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="nottickedoff">rendered = renderSvg (Just $ Px $ fromIntegral width)</span>
|
||||
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="nottickedoff">(Just $ Px $ fromIntegral height)</span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="nottickedoff">svg</span></span>
|
||||
<span class="lineno"> 145 </span>
|
||||
<span class="lineno"> 146 </span>
|
||||
<span class="lineno"> 147 </span>{-# INLINE embedImage #-}
|
||||
<span class="lineno"> 148 </span>-- | Embed an in-memory PNG image. Note, the pixel size of the image
|
||||
<span class="lineno"> 149 </span>-- is used as the dimensions. As such, embedding a 100x100 PNG will
|
||||
<span class="lineno"> 150 </span>-- result in an image 100 units wide and 100 units high. Consider
|
||||
<span class="lineno"> 151 </span>-- using with 'scaleToSize'.
|
||||
<span class="lineno"> 152 </span>embedImage :: PngSavable a => Image a -> SVG
|
||||
<span class="lineno"> 153 </span><span class="decl"><span class="istickedoff">embedImage img = embedPng width height (encodePng img)</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="istickedoff">width = fromIntegral $ imageWidth img</span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="istickedoff">height = fromIntegral $ imageHeight img</span></span>
|
||||
<span class="lineno"> 157 </span>
|
||||
<span class="lineno"> 158 </span>-- | Embed in-memory PNG bytestring without parsing it.
|
||||
<span class="lineno"> 159 </span>embedPng
|
||||
<span class="lineno"> 160 </span> :: Double -- ^ Width
|
||||
<span class="lineno"> 161 </span> -> Double -- ^ Height
|
||||
<span class="lineno"> 162 </span> -> LBS.ByteString -- ^ Raw PNG data
|
||||
<span class="lineno"> 163 </span> -> SVG
|
||||
<span class="lineno"> 164 </span>-- embedPng w h png = unsafePerformIO $ do
|
||||
<span class="lineno"> 165 </span>-- LBS.writeFile path png
|
||||
<span class="lineno"> 166 </span>-- return $ ImageTree $ defaultSvg
|
||||
<span class="lineno"> 167 </span>-- & Svg.imageCornerUpperLeft .~ (Svg.Num (-w/2), Svg.Num (-h/2))
|
||||
<span class="lineno"> 168 </span>-- & Svg.imageWidth .~ Svg.Num w
|
||||
<span class="lineno"> 169 </span>-- & Svg.imageHeight .~ Svg.Num h
|
||||
<span class="lineno"> 170 </span>-- & Svg.imageHref .~ ("file://"++path)
|
||||
<span class="lineno"> 171 </span>-- where
|
||||
<span class="lineno"> 172 </span>-- path = "/tmp" </> show (hash png) <.> "png"
|
||||
<span class="lineno"> 173 </span><span class="decl"><span class="istickedoff">embedPng w h png =</span>
|
||||
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="istickedoff">flipYAxis</span>
|
||||
<span class="lineno"> 175 </span><span class="spaces"> </span><span class="istickedoff">$ ImageTree</span>
|
||||
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="istickedoff">$ defaultSvg</span>
|
||||
<span class="lineno"> 177 </span><span class="spaces"> </span><span class="istickedoff">& Svg.imageCornerUpperLeft</span>
|
||||
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="istickedoff">.~ (Svg.Num (-w / 2), Svg.Num (-h / 2))</span>
|
||||
<span class="lineno"> 179 </span><span class="spaces"> </span><span class="istickedoff">& Svg.imageWidth</span>
|
||||
<span class="lineno"> 180 </span><span class="spaces"> </span><span class="istickedoff">.~ Svg.Num w</span>
|
||||
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="istickedoff">& Svg.imageHeight</span>
|
||||
<span class="lineno"> 182 </span><span class="spaces"> </span><span class="istickedoff">.~ Svg.Num h</span>
|
||||
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="istickedoff">& Svg.imageHref</span>
|
||||
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="istickedoff">.~ ("data:image/png;base64," ++ imgData)</span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="istickedoff">where imgData = LBS.unpack $ Base64.encode png</span></span>
|
||||
<span class="lineno"> 186 </span>
|
||||
<span class="lineno"> 187 </span>
|
||||
<span class="lineno"> 188 </span>{-# INLINE embedDynamicImage #-}
|
||||
<span class="lineno"> 189 </span>-- | Embed an in-memory image. Note, the pixel size of the image
|
||||
<span class="lineno"> 190 </span>-- is used as the dimensions. As such, embedding a 100x100 image will
|
||||
<span class="lineno"> 191 </span>-- result in an image 100 units wide and 100 units high. Consider
|
||||
<span class="lineno"> 192 </span>-- using with 'scaleToSize'.
|
||||
<span class="lineno"> 193 </span>embedDynamicImage :: DynamicImage -> SVG
|
||||
<span class="lineno"> 194 </span><span class="decl"><span class="nottickedoff">embedDynamicImage img = embedPng width height imgData</span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="nottickedoff">width = fromIntegral $ dynamicMap imageWidth img</span>
|
||||
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="nottickedoff">height = fromIntegral $ dynamicMap imageHeight img</span>
|
||||
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="nottickedoff">imgData = case encodeDynamicPng img of</span>
|
||||
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="nottickedoff">Left err -> error err</span>
|
||||
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="nottickedoff">Right dat -> dat</span></span>
|
||||
<span class="lineno"> 201 </span>
|
||||
<span class="lineno"> 202 </span>-- embedImageFile :: FilePath -> Tree
|
||||
<span class="lineno"> 203 </span>-- embedImageFile path = unsafePerformIO $ do
|
||||
<span class="lineno"> 204 </span>-- png <- B.readFile path
|
||||
<span class="lineno"> 205 </span>-- case decodePng png of
|
||||
<span class="lineno"> 206 </span>-- Left{} -> error "bad image"
|
||||
<span class="lineno"> 207 </span>-- Right img -> return $
|
||||
<span class="lineno"> 208 </span>-- let width = fromIntegral $ dynamicMap imageWidth img
|
||||
<span class="lineno"> 209 </span>-- height = fromIntegral $ dynamicMap imageHeight img in
|
||||
<span class="lineno"> 210 </span>-- ImageTree $ defaultSvg
|
||||
<span class="lineno"> 211 </span>-- & Svg.imageCornerUpperLeft .~ (Svg.Num (-width/2), Svg.Num (-height/2))
|
||||
<span class="lineno"> 212 </span>-- & Svg.imageWidth .~ Svg.Num width
|
||||
<span class="lineno"> 213 </span>-- & Svg.imageHeight .~ Svg.Num height
|
||||
<span class="lineno"> 214 </span>-- & Svg.imageHref .~ ("file://" ++ path)
|
||||
<span class="lineno"> 215 </span>
|
||||
<span class="lineno"> 216 </span>
|
||||
<span class="lineno"> 217 </span>-- | Convert an SVG object to a pixel-based image. The default resolution
|
||||
<span class="lineno"> 218 </span>-- is 2560x1440. See also 'rasterSized'. Multiple raster engines are supported
|
||||
<span class="lineno"> 219 </span>-- and are selected using the '--raster' flag in the driver.
|
||||
<span class="lineno"> 220 </span>raster :: SVG -> DynamicImage
|
||||
<span class="lineno"> 221 </span><span class="decl"><span class="nottickedoff">raster = rasterSized 2560 1440</span></span>
|
||||
<span class="lineno"> 222 </span>
|
||||
<span class="lineno"> 223 </span>-- | Convert an SVG object to a pixel-based image.
|
||||
<span class="lineno"> 224 </span>rasterSized
|
||||
<span class="lineno"> 225 </span> :: Width -- ^ X resolution in pixels
|
||||
<span class="lineno"> 226 </span> -> Height -- ^ Y resolution in pixels
|
||||
<span class="lineno"> 227 </span> -> SVG -- ^ SVG object
|
||||
<span class="lineno"> 228 </span> -> DynamicImage
|
||||
<span class="lineno"> 229 </span><span class="decl"><span class="nottickedoff">rasterSized w h svg = unsafePerformIO $ do</span>
|
||||
<span class="lineno"> 230 </span><span class="spaces"> </span><span class="nottickedoff">png <- B.readFile (svgAsPngFile' w h svg)</span>
|
||||
<span class="lineno"> 231 </span><span class="spaces"> </span><span class="nottickedoff">case decodePng png of</span>
|
||||
<span class="lineno"> 232 </span><span class="spaces"> </span><span class="nottickedoff">Left{} -> error "bad image"</span>
|
||||
<span class="lineno"> 233 </span><span class="spaces"> </span><span class="nottickedoff">Right img -> return img</span></span>
|
||||
<span class="lineno"> 234 </span>
|
||||
<span class="lineno"> 235 </span>-- | Use 'potrace' to trace edges in a raster image and convert them to SVG polygons.
|
||||
<span class="lineno"> 236 </span>vectorize :: FilePath -> SVG
|
||||
<span class="lineno"> 237 </span><span class="decl"><span class="nottickedoff">vectorize = vectorize_ []</span></span>
|
||||
<span class="lineno"> 238 </span>
|
||||
<span class="lineno"> 239 </span>-- | Same as 'vectorize' but takes a list of arguments for 'potrace'.
|
||||
<span class="lineno"> 240 </span>vectorize_ :: [String] -> FilePath -> SVG
|
||||
<span class="lineno"> 241 </span><span class="decl"><span class="nottickedoff">vectorize_ _ path | pNoExternals = mkText $ T.pack path</span>
|
||||
<span class="lineno"> 242 </span><span class="spaces"></span><span class="nottickedoff">vectorize_ args path = unsafePerformIO $ do</span>
|
||||
<span class="lineno"> 243 </span><span class="spaces"> </span><span class="nottickedoff">root <- getXdgDirectory XdgCache "reanimate"</span>
|
||||
<span class="lineno"> 244 </span><span class="spaces"> </span><span class="nottickedoff">createDirectoryIfMissing True root</span>
|
||||
<span class="lineno"> 245 </span><span class="spaces"> </span><span class="nottickedoff">let svgPath = root </> encodeInt key <.> "svg"</span>
|
||||
<span class="lineno"> 246 </span><span class="spaces"> </span><span class="nottickedoff">hit <- doesFileExist svgPath</span>
|
||||
<span class="lineno"> 247 </span><span class="spaces"> </span><span class="nottickedoff">unless hit $ withSystemTempFile "file.svg" $ \tmpSvgPath svgH -></span>
|
||||
<span class="lineno"> 248 </span><span class="spaces"> </span><span class="nottickedoff">withSystemTempFile "file.bmp" $ \tmpBmpPath bmpH -> do</span>
|
||||
<span class="lineno"> 249 </span><span class="spaces"> </span><span class="nottickedoff">hClose svgH</span>
|
||||
<span class="lineno"> 250 </span><span class="spaces"> </span><span class="nottickedoff">hClose bmpH</span>
|
||||
<span class="lineno"> 251 </span><span class="spaces"> </span><span class="nottickedoff">potrace <- requireExecutable "potrace"</span>
|
||||
<span class="lineno"> 252 </span><span class="spaces"> </span><span class="nottickedoff">magick <- requireExecutable magickCmd</span>
|
||||
<span class="lineno"> 253 </span><span class="spaces"> </span><span class="nottickedoff">runCmd magick [path, "-flatten", tmpBmpPath]</span>
|
||||
<span class="lineno"> 254 </span><span class="spaces"> </span><span class="nottickedoff">runCmd potrace (args ++ ["--svg", "--output", tmpSvgPath, tmpBmpPath])</span>
|
||||
<span class="lineno"> 255 </span><span class="spaces"> </span><span class="nottickedoff">renameOrCopyFile tmpSvgPath svgPath</span>
|
||||
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="nottickedoff">svg_data <- B.readFile svgPath</span>
|
||||
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="nottickedoff">case parseSvgFile svgPath svg_data of</span>
|
||||
<span class="lineno"> 258 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> do</span>
|
||||
<span class="lineno"> 259 </span><span class="spaces"> </span><span class="nottickedoff">removeFile svgPath</span>
|
||||
<span class="lineno"> 260 </span><span class="spaces"> </span><span class="nottickedoff">error "Malformed svg"</span>
|
||||
<span class="lineno"> 261 </span><span class="spaces"> </span><span class="nottickedoff">Just svg -> return $ unbox $ replaceUses svg</span>
|
||||
<span class="lineno"> 262 </span><span class="spaces"> </span><span class="nottickedoff">where key = hash (path, args)</span></span>
|
||||
<span class="lineno"> 263 </span>
|
||||
<span class="lineno"> 264 </span>-- imageAsFile :: DynamicImage -> FilePath
|
||||
<span class="lineno"> 265 </span>-- imageAsFile img
|
||||
<span class="lineno"> 266 </span>
|
||||
<span class="lineno"> 267 </span>-- | Convert an SVG object to a pixel-based image and save it to disk, returning
|
||||
<span class="lineno"> 268 </span>-- the filepath. The default resolution is 2560x1440. See also 'svgAsPngFile''.
|
||||
<span class="lineno"> 269 </span>-- Multiple raster engines are supported and are selected using the '--raster'
|
||||
<span class="lineno"> 270 </span>-- flag in the driver.
|
||||
<span class="lineno"> 271 </span>svgAsPngFile :: SVG -> FilePath
|
||||
<span class="lineno"> 272 </span><span class="decl"><span class="nottickedoff">svgAsPngFile = svgAsPngFile' width height</span>
|
||||
<span class="lineno"> 273 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 274 </span><span class="spaces"> </span><span class="nottickedoff">width = 2560</span>
|
||||
<span class="lineno"> 275 </span><span class="spaces"> </span><span class="nottickedoff">height = width * 9 `div` 16</span></span>
|
||||
<span class="lineno"> 276 </span>
|
||||
<span class="lineno"> 277 </span>-- | Convert an SVG object to a pixel-based image and save it to disk, returning
|
||||
<span class="lineno"> 278 </span>-- the filepath.
|
||||
<span class="lineno"> 279 </span>svgAsPngFile'
|
||||
<span class="lineno"> 280 </span> :: Width -- ^ Width
|
||||
<span class="lineno"> 281 </span> -> Height -- ^ Height
|
||||
<span class="lineno"> 282 </span> -> SVG -- ^ SVG object
|
||||
<span class="lineno"> 283 </span> -> FilePath
|
||||
<span class="lineno"> 284 </span><span class="decl"><span class="nottickedoff">svgAsPngFile' _ _ _ | pNoExternals = "/svgAsPngFile/has/been/disabled"</span>
|
||||
<span class="lineno"> 285 </span><span class="spaces"></span><span class="nottickedoff">svgAsPngFile' width height svg =</span>
|
||||
<span class="lineno"> 286 </span><span class="spaces"> </span><span class="nottickedoff">unsafePerformIO $ cacheFile template $ \pngPath -> do</span>
|
||||
<span class="lineno"> 287 </span><span class="spaces"> </span><span class="nottickedoff">let svgPath = replaceExtension pngPath "svg"</span>
|
||||
<span class="lineno"> 288 </span><span class="spaces"> </span><span class="nottickedoff">writeFile svgPath rendered</span>
|
||||
<span class="lineno"> 289 </span><span class="spaces"> </span><span class="nottickedoff">engine <- requireRaster pRaster</span>
|
||||
<span class="lineno"> 290 </span><span class="spaces"> </span><span class="nottickedoff">applyRaster engine svgPath</span>
|
||||
<span class="lineno"> 291 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 292 </span><span class="spaces"> </span><span class="nottickedoff">template = encodeInt (hash rendered) <.> "png"</span>
|
||||
<span class="lineno"> 293 </span><span class="spaces"> </span><span class="nottickedoff">rendered = renderSvg (Just $ Px $ fromIntegral width)</span>
|
||||
<span class="lineno"> 294 </span><span class="spaces"> </span><span class="nottickedoff">(Just $ Px $ fromIntegral height)</span>
|
||||
<span class="lineno"> 295 </span><span class="spaces"> </span><span class="nottickedoff">svg</span></span>
|
||||
<span class="lineno"> 146 </span>-- | Render SVG node to a PNG file and return a new node containing
|
||||
<span class="lineno"> 147 </span>-- that image. For static SVG nodes, this can hugely improve performance.
|
||||
<span class="lineno"> 148 </span>-- The first argument is the key that determines SVG uniqueness. It
|
||||
<span class="lineno"> 149 </span>-- is entirely your responsibility to ensure that all keys are unique.
|
||||
<span class="lineno"> 150 </span>-- If they are not, you will be served stale results from the cache.
|
||||
<span class="lineno"> 151 </span>prerenderSvg :: Hashable a => a -> SVG -> SVG
|
||||
<span class="lineno"> 152 </span><span class="decl"><span class="nottickedoff">prerenderSvg key =</span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="nottickedoff">mkImage screenWidth screenHeight . prerenderSvgFile key pWidth pHeight</span></span>
|
||||
<span class="lineno"> 154 </span>
|
||||
<span class="lineno"> 155 </span>
|
||||
<span class="lineno"> 156 </span>{-# INLINE embedImage #-}
|
||||
<span class="lineno"> 157 </span>-- | Embed an in-memory PNG image. Note, the pixel size of the image
|
||||
<span class="lineno"> 158 </span>-- is used as the dimensions. As such, embedding a 100x100 PNG will
|
||||
<span class="lineno"> 159 </span>-- result in an image 100 units wide and 100 units high. Consider
|
||||
<span class="lineno"> 160 </span>-- using with 'scaleToSize'.
|
||||
<span class="lineno"> 161 </span>embedImage :: PngSavable a => Image a -> SVG
|
||||
<span class="lineno"> 162 </span><span class="decl"><span class="istickedoff">embedImage img = embedPng width height (encodePng img)</span>
|
||||
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="istickedoff">width = fromIntegral $ imageWidth img</span>
|
||||
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="istickedoff">height = fromIntegral $ imageHeight img</span></span>
|
||||
<span class="lineno"> 166 </span>
|
||||
<span class="lineno"> 167 </span>-- | Embed in-memory PNG bytestring without parsing it.
|
||||
<span class="lineno"> 168 </span>embedPng
|
||||
<span class="lineno"> 169 </span> :: Double -- ^ Width
|
||||
<span class="lineno"> 170 </span> -> Double -- ^ Height
|
||||
<span class="lineno"> 171 </span> -> LBS.ByteString -- ^ Raw PNG data
|
||||
<span class="lineno"> 172 </span> -> SVG
|
||||
<span class="lineno"> 173 </span>-- embedPng w h png = unsafePerformIO $ do
|
||||
<span class="lineno"> 174 </span>-- LBS.writeFile path png
|
||||
<span class="lineno"> 175 </span>-- return $ ImageTree $ defaultSvg
|
||||
<span class="lineno"> 176 </span>-- & Svg.imageCornerUpperLeft .~ (Svg.Num (-w/2), Svg.Num (-h/2))
|
||||
<span class="lineno"> 177 </span>-- & Svg.imageWidth .~ Svg.Num w
|
||||
<span class="lineno"> 178 </span>-- & Svg.imageHeight .~ Svg.Num h
|
||||
<span class="lineno"> 179 </span>-- & Svg.imageHref .~ ("file://"++path)
|
||||
<span class="lineno"> 180 </span>-- where
|
||||
<span class="lineno"> 181 </span>-- path = "/tmp" </> show (hash png) <.> "png"
|
||||
<span class="lineno"> 182 </span><span class="decl"><span class="istickedoff">embedPng w h png =</span>
|
||||
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="istickedoff">flipYAxis</span>
|
||||
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="istickedoff">$ ImageTree</span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="istickedoff">$ defaultSvg</span>
|
||||
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="istickedoff">& Svg.imageCornerUpperLeft</span>
|
||||
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="istickedoff">.~ (Svg.Num (-w / 2), Svg.Num (-h / 2))</span>
|
||||
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="istickedoff">& Svg.imageWidth</span>
|
||||
<span class="lineno"> 189 </span><span class="spaces"> </span><span class="istickedoff">.~ Svg.Num w</span>
|
||||
<span class="lineno"> 190 </span><span class="spaces"> </span><span class="istickedoff">& Svg.imageHeight</span>
|
||||
<span class="lineno"> 191 </span><span class="spaces"> </span><span class="istickedoff">.~ Svg.Num h</span>
|
||||
<span class="lineno"> 192 </span><span class="spaces"> </span><span class="istickedoff">& Svg.imageHref</span>
|
||||
<span class="lineno"> 193 </span><span class="spaces"> </span><span class="istickedoff">.~ ("data:image/png;base64," ++ imgData)</span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="istickedoff">where imgData = LBS.unpack $ Base64.encode png</span></span>
|
||||
<span class="lineno"> 195 </span>
|
||||
<span class="lineno"> 196 </span>
|
||||
<span class="lineno"> 197 </span>{-# INLINE embedDynamicImage #-}
|
||||
<span class="lineno"> 198 </span>-- | Embed an in-memory image. Note, the pixel size of the image
|
||||
<span class="lineno"> 199 </span>-- is used as the dimensions. As such, embedding a 100x100 image will
|
||||
<span class="lineno"> 200 </span>-- result in an image 100 units wide and 100 units high. Consider
|
||||
<span class="lineno"> 201 </span>-- using with 'scaleToSize'.
|
||||
<span class="lineno"> 202 </span>embedDynamicImage :: DynamicImage -> SVG
|
||||
<span class="lineno"> 203 </span><span class="decl"><span class="nottickedoff">embedDynamicImage img = embedPng width height imgData</span>
|
||||
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="nottickedoff">width = fromIntegral $ dynamicMap imageWidth img</span>
|
||||
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="nottickedoff">height = fromIntegral $ dynamicMap imageHeight img</span>
|
||||
<span class="lineno"> 207 </span><span class="spaces"> </span><span class="nottickedoff">imgData = case encodeDynamicPng img of</span>
|
||||
<span class="lineno"> 208 </span><span class="spaces"> </span><span class="nottickedoff">Left err -> error err</span>
|
||||
<span class="lineno"> 209 </span><span class="spaces"> </span><span class="nottickedoff">Right dat -> dat</span></span>
|
||||
<span class="lineno"> 210 </span>
|
||||
<span class="lineno"> 211 </span>-- embedImageFile :: FilePath -> Tree
|
||||
<span class="lineno"> 212 </span>-- embedImageFile path = unsafePerformIO $ do
|
||||
<span class="lineno"> 213 </span>-- png <- B.readFile path
|
||||
<span class="lineno"> 214 </span>-- case decodePng png of
|
||||
<span class="lineno"> 215 </span>-- Left{} -> error "bad image"
|
||||
<span class="lineno"> 216 </span>-- Right img -> return $
|
||||
<span class="lineno"> 217 </span>-- let width = fromIntegral $ dynamicMap imageWidth img
|
||||
<span class="lineno"> 218 </span>-- height = fromIntegral $ dynamicMap imageHeight img in
|
||||
<span class="lineno"> 219 </span>-- ImageTree $ defaultSvg
|
||||
<span class="lineno"> 220 </span>-- & Svg.imageCornerUpperLeft .~ (Svg.Num (-width/2), Svg.Num (-height/2))
|
||||
<span class="lineno"> 221 </span>-- & Svg.imageWidth .~ Svg.Num width
|
||||
<span class="lineno"> 222 </span>-- & Svg.imageHeight .~ Svg.Num height
|
||||
<span class="lineno"> 223 </span>-- & Svg.imageHref .~ ("file://" ++ path)
|
||||
<span class="lineno"> 224 </span>
|
||||
<span class="lineno"> 225 </span>
|
||||
<span class="lineno"> 226 </span>-- | Convert an SVG object to a pixel-based image. The default resolution
|
||||
<span class="lineno"> 227 </span>-- is 2560x1440. See also 'rasterSized'. Multiple raster engines are supported
|
||||
<span class="lineno"> 228 </span>-- and are selected using the '--raster' flag in the driver.
|
||||
<span class="lineno"> 229 </span>raster :: SVG -> DynamicImage
|
||||
<span class="lineno"> 230 </span><span class="decl"><span class="nottickedoff">raster = rasterSized 2560 1440</span></span>
|
||||
<span class="lineno"> 231 </span>
|
||||
<span class="lineno"> 232 </span>-- | Convert an SVG object to a pixel-based image.
|
||||
<span class="lineno"> 233 </span>rasterSized
|
||||
<span class="lineno"> 234 </span> :: Width -- ^ X resolution in pixels
|
||||
<span class="lineno"> 235 </span> -> Height -- ^ Y resolution in pixels
|
||||
<span class="lineno"> 236 </span> -> SVG -- ^ SVG object
|
||||
<span class="lineno"> 237 </span> -> DynamicImage
|
||||
<span class="lineno"> 238 </span><span class="decl"><span class="nottickedoff">rasterSized w h svg = unsafePerformIO $ do</span>
|
||||
<span class="lineno"> 239 </span><span class="spaces"> </span><span class="nottickedoff">png <- B.readFile (svgAsPngFile' w h svg)</span>
|
||||
<span class="lineno"> 240 </span><span class="spaces"> </span><span class="nottickedoff">case decodePng png of</span>
|
||||
<span class="lineno"> 241 </span><span class="spaces"> </span><span class="nottickedoff">Left{} -> error "bad image"</span>
|
||||
<span class="lineno"> 242 </span><span class="spaces"> </span><span class="nottickedoff">Right img -> return img</span></span>
|
||||
<span class="lineno"> 243 </span>
|
||||
<span class="lineno"> 244 </span>-- | Use 'potrace' to trace edges in a raster image and convert them to SVG polygons.
|
||||
<span class="lineno"> 245 </span>vectorize :: FilePath -> SVG
|
||||
<span class="lineno"> 246 </span><span class="decl"><span class="nottickedoff">vectorize = vectorize_ []</span></span>
|
||||
<span class="lineno"> 247 </span>
|
||||
<span class="lineno"> 248 </span>-- | Same as 'vectorize' but takes a list of arguments for 'potrace'.
|
||||
<span class="lineno"> 249 </span>vectorize_ :: [String] -> FilePath -> SVG
|
||||
<span class="lineno"> 250 </span><span class="decl"><span class="nottickedoff">vectorize_ _ path | pNoExternals = mkText $ T.pack path</span>
|
||||
<span class="lineno"> 251 </span><span class="spaces"></span><span class="nottickedoff">vectorize_ args path = unsafePerformIO $ do</span>
|
||||
<span class="lineno"> 252 </span><span class="spaces"> </span><span class="nottickedoff">root <- getXdgDirectory XdgCache "reanimate"</span>
|
||||
<span class="lineno"> 253 </span><span class="spaces"> </span><span class="nottickedoff">createDirectoryIfMissing True root</span>
|
||||
<span class="lineno"> 254 </span><span class="spaces"> </span><span class="nottickedoff">let svgPath = root </> encodeInt key <.> "svg"</span>
|
||||
<span class="lineno"> 255 </span><span class="spaces"> </span><span class="nottickedoff">hit <- doesFileExist svgPath</span>
|
||||
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="nottickedoff">unless hit $ withSystemTempFile "file.svg" $ \tmpSvgPath svgH -></span>
|
||||
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="nottickedoff">withSystemTempFile "file.bmp" $ \tmpBmpPath bmpH -> do</span>
|
||||
<span class="lineno"> 258 </span><span class="spaces"> </span><span class="nottickedoff">hClose svgH</span>
|
||||
<span class="lineno"> 259 </span><span class="spaces"> </span><span class="nottickedoff">hClose bmpH</span>
|
||||
<span class="lineno"> 260 </span><span class="spaces"> </span><span class="nottickedoff">potrace <- requireExecutable "potrace"</span>
|
||||
<span class="lineno"> 261 </span><span class="spaces"> </span><span class="nottickedoff">magick <- requireExecutable magickCmd</span>
|
||||
<span class="lineno"> 262 </span><span class="spaces"> </span><span class="nottickedoff">runCmd magick [path, "-flatten", tmpBmpPath]</span>
|
||||
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="nottickedoff">runCmd potrace (args ++ ["--svg", "--output", tmpSvgPath, tmpBmpPath])</span>
|
||||
<span class="lineno"> 264 </span><span class="spaces"> </span><span class="nottickedoff">renameOrCopyFile tmpSvgPath svgPath</span>
|
||||
<span class="lineno"> 265 </span><span class="spaces"> </span><span class="nottickedoff">svg_data <- B.readFile svgPath</span>
|
||||
<span class="lineno"> 266 </span><span class="spaces"> </span><span class="nottickedoff">case parseSvgFile svgPath svg_data of</span>
|
||||
<span class="lineno"> 267 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> do</span>
|
||||
<span class="lineno"> 268 </span><span class="spaces"> </span><span class="nottickedoff">removeFile svgPath</span>
|
||||
<span class="lineno"> 269 </span><span class="spaces"> </span><span class="nottickedoff">error "Malformed svg"</span>
|
||||
<span class="lineno"> 270 </span><span class="spaces"> </span><span class="nottickedoff">Just svg -> return $ unbox $ replaceUses svg</span>
|
||||
<span class="lineno"> 271 </span><span class="spaces"> </span><span class="nottickedoff">where key = hash (path, args)</span></span>
|
||||
<span class="lineno"> 272 </span>
|
||||
<span class="lineno"> 273 </span>-- imageAsFile :: DynamicImage -> FilePath
|
||||
<span class="lineno"> 274 </span>-- imageAsFile img
|
||||
<span class="lineno"> 275 </span>
|
||||
<span class="lineno"> 276 </span>-- | Convert an SVG object to a pixel-based image and save it to disk, returning
|
||||
<span class="lineno"> 277 </span>-- the filepath. The default resolution is 2560x1440. See also 'svgAsPngFile''.
|
||||
<span class="lineno"> 278 </span>-- Multiple raster engines are supported and are selected using the '--raster'
|
||||
<span class="lineno"> 279 </span>-- flag in the driver.
|
||||
<span class="lineno"> 280 </span>svgAsPngFile :: SVG -> FilePath
|
||||
<span class="lineno"> 281 </span><span class="decl"><span class="nottickedoff">svgAsPngFile = svgAsPngFile' width height</span>
|
||||
<span class="lineno"> 282 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 283 </span><span class="spaces"> </span><span class="nottickedoff">width = 2560</span>
|
||||
<span class="lineno"> 284 </span><span class="spaces"> </span><span class="nottickedoff">height = width * 9 `div` 16</span></span>
|
||||
<span class="lineno"> 285 </span>
|
||||
<span class="lineno"> 286 </span>-- | Convert an SVG object to a pixel-based image and save it to disk, returning
|
||||
<span class="lineno"> 287 </span>-- the filepath.
|
||||
<span class="lineno"> 288 </span>svgAsPngFile'
|
||||
<span class="lineno"> 289 </span> :: Width -- ^ Width
|
||||
<span class="lineno"> 290 </span> -> Height -- ^ Height
|
||||
<span class="lineno"> 291 </span> -> SVG -- ^ SVG object
|
||||
<span class="lineno"> 292 </span> -> FilePath
|
||||
<span class="lineno"> 293 </span><span class="decl"><span class="nottickedoff">svgAsPngFile' _ _ _ | pNoExternals = "/svgAsPngFile/has/been/disabled"</span>
|
||||
<span class="lineno"> 294 </span><span class="spaces"></span><span class="nottickedoff">svgAsPngFile' width height svg =</span>
|
||||
<span class="lineno"> 295 </span><span class="spaces"> </span><span class="nottickedoff">unsafePerformIO $ cacheFile template $ \pngPath -> do</span>
|
||||
<span class="lineno"> 296 </span><span class="spaces"> </span><span class="nottickedoff">let svgPath = replaceExtension pngPath "svg"</span>
|
||||
<span class="lineno"> 297 </span><span class="spaces"> </span><span class="nottickedoff">writeFile svgPath rendered</span>
|
||||
<span class="lineno"> 298 </span><span class="spaces"> </span><span class="nottickedoff">engine <- requireRaster pRaster</span>
|
||||
<span class="lineno"> 299 </span><span class="spaces"> </span><span class="nottickedoff">applyRaster engine svgPath</span>
|
||||
<span class="lineno"> 300 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 301 </span><span class="spaces"> </span><span class="nottickedoff">template = encodeInt (hash rendered) <.> "png"</span>
|
||||
<span class="lineno"> 302 </span><span class="spaces"> </span><span class="nottickedoff">rendered = renderSvg (Just $ Px $ fromIntegral width)</span>
|
||||
<span class="lineno"> 303 </span><span class="spaces"> </span><span class="nottickedoff">(Just $ Px $ fromIntegral height)</span>
|
||||
<span class="lineno"> 304 </span><span class="spaces"> </span><span class="nottickedoff">svg</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -17,119 +17,135 @@ span.spaces { background: white }
|
|||
<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.BoundingBox where
|
||||
<span class="lineno"> 2 </span>
|
||||
<span class="lineno"> 3 </span>import Control.Arrow ((***))
|
||||
<span class="lineno"> 4 </span>import Control.Lens ((^.))
|
||||
<span class="lineno"> 5 </span>import Data.List
|
||||
<span class="lineno"> 6 </span>import Data.Maybe (mapMaybe)
|
||||
<span class="lineno"> 7 </span>import Graphics.SvgTree hiding (height, line, path, use,
|
||||
<span class="lineno"> 8 </span> width)
|
||||
<span class="lineno"> 9 </span>import Linear.V2 hiding (angle)
|
||||
<span class="lineno"> 10 </span>import Linear.Vector
|
||||
<span class="lineno"> 11 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 12 </span>import Reanimate.Svg.LineCommand
|
||||
<span class="lineno"> 13 </span>import qualified Reanimate.Transform as Transform
|
||||
<span class="lineno"> 14 </span>-- import qualified Geom2D.CubicBezier as Bezier
|
||||
<span class="lineno"> 15 </span>
|
||||
<span class="lineno"> 16 </span>-- | Return bounding box of SVG tree.
|
||||
<span class="lineno"> 17 </span>-- The four numbers returned are (minimal X-coordinate, minimal Y-coordinate, width, height)
|
||||
<span class="lineno"> 18 </span>--
|
||||
<span class="lineno"> 19 </span>-- Note: Bounding boxes are computed on a best-effort basis and will not work
|
||||
<span class="lineno"> 20 </span>-- in all cases. The only supported SVG nodes are: path, circle, polyline,
|
||||
<span class="lineno"> 21 </span>-- ellipse, line, rectangle, image. All other nodes return (0,0,0,0).
|
||||
<span class="lineno"> 22 </span>boundingBox :: Tree -> (Double, Double, Double, Double)
|
||||
<span class="lineno"> 23 </span><span class="decl"><span class="istickedoff">boundingBox t =</span>
|
||||
<span class="lineno"> 24 </span><span class="spaces"> </span><span class="istickedoff">case svgBoundingPoints t of</span>
|
||||
<span class="lineno"> 25 </span><span class="spaces"> </span><span class="istickedoff">[] -> (0,0,0,0)</span>
|
||||
<span class="lineno"> 26 </span><span class="spaces"> </span><span class="istickedoff">(V2 x y:rest) -></span>
|
||||
<span class="lineno"> 27 </span><span class="spaces"> </span><span class="istickedoff">let (minx, miny, maxx, maxy) = foldl' worker (x, y, x, y) rest</span>
|
||||
<span class="lineno"> 28 </span><span class="spaces"> </span><span class="istickedoff">in (minx, miny, maxx-minx, maxy-miny)</span>
|
||||
<span class="lineno"> 29 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 30 </span><span class="spaces"> </span><span class="istickedoff">worker (minx, miny, maxx, maxy) (V2 x y) =</span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="istickedoff">(min minx x, min miny y, max maxx x, max maxy y)</span></span>
|
||||
<span class="lineno"> 32 </span>
|
||||
<span class="lineno"> 33 </span>svgHeight :: Tree -> Double
|
||||
<span class="lineno"> 34 </span><span class="decl"><span class="nottickedoff">svgHeight t = h</span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="nottickedoff">(_x, _y, _w, h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 37 </span>
|
||||
<span class="lineno"> 38 </span>svgWidth :: Tree -> Double
|
||||
<span class="lineno"> 39 </span><span class="decl"><span class="nottickedoff">svgWidth t = w</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="nottickedoff">(_x, _y, w, _h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 42 </span>
|
||||
<span class="lineno"> 43 </span>linePoints :: [LineCommand] -> [RPoint]
|
||||
<span class="lineno"> 44 </span><span class="decl"><span class="nottickedoff">linePoints = worker zero</span>
|
||||
<span class="lineno"> 45 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="nottickedoff">worker _from [] = []</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="nottickedoff">worker from (x:xs) =</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="nottickedoff">case x of</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="nottickedoff">LineMove to -> worker to xs</span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="nottickedoff">-- LineDraw to -> from:to:worker to xs</span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="nottickedoff">LineBezier [p] -></span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="nottickedoff">p : worker p xs</span>
|
||||
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="nottickedoff">LineBezier ctrl -> -- approximation</span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="nottickedoff">[ last (partialBezierPoints (from:ctrl) 0 (recip chunks*i)) | i <- [0..chunks]] ++</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="nottickedoff">worker (last ctrl) xs</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="nottickedoff">LineEnd p -> p : worker p xs</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="nottickedoff">chunks = 10</span></span>
|
||||
<span class="lineno"> 58 </span>
|
||||
<span class="lineno"> 59 </span>svgBoundingPoints :: Tree -> [RPoint]
|
||||
<span class="lineno"> 60 </span><span class="decl"><span class="istickedoff">svgBoundingPoints t = map (Transform.transformPoint m) $</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="istickedoff">case t of</span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="istickedoff">None -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="istickedoff">UseTree{} -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 64 </span><span class="spaces"> </span><span class="istickedoff">GroupTree g -> concatMap svgBoundingPoints (g^.groupChildren)</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="istickedoff">SymbolTree (Symbol g) -> <span class="nottickedoff">concatMap svgBoundingPoints (g^.groupChildren)</span></span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="istickedoff">FilterTree{} -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="istickedoff">DefinitionTree{} -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="istickedoff">PathTree p -> <span class="nottickedoff">linePoints $ toLineCommands (p^.pathDefinition)</span></span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="istickedoff">CircleTree c -> <span class="nottickedoff">circleBoundingPoints c</span></span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="istickedoff">PolyLineTree pl -> <span class="nottickedoff">pl ^. polyLinePoints</span></span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="istickedoff">EllipseTree e -> <span class="nottickedoff">ellipseBoundingPoints e</span></span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="istickedoff">LineTree line -> <span class="nottickedoff">map pointToRPoint [line^.linePoint1, line^.linePoint2]</span></span>
|
||||
<span class="lineno"> 73 </span><span class="spaces"> </span><span class="istickedoff">RectangleTree rect -></span>
|
||||
<span class="lineno"> 74 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case pointToRPoint (rect^.rectUpperLeftCorner) of</span></span>
|
||||
<span class="lineno"> 75 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">V2 x y -> V2 x y :</span></span>
|
||||
<span class="lineno"> 76 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case mapTuple (fmap $ toUserUnit defaultDPI) (rect^.rectWidth, rect^.rectHeight) of</span></span>
|
||||
<span class="lineno"> 77 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(Just (Num w), Just (Num h)) -> [V2 (x+w) (y+h)]</span></span>
|
||||
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> []</span></span>
|
||||
<span class="lineno"> 79 </span><span class="spaces"> </span><span class="istickedoff">TextTree{} -> []</span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="istickedoff">ImageTree img -></span>
|
||||
<span class="lineno"> 81 </span><span class="spaces"> </span><span class="istickedoff">case (img^.imageCornerUpperLeft, img^.imageWidth, img^.imageHeight) of</span>
|
||||
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="istickedoff">((Num x, Num y), Num w, Num h) -></span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="istickedoff">[V2 x y, V2 (x+w) (y+h)]</span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="istickedoff">MeshGradientTree{} -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="istickedoff">m = Transform.mkMatrix (t^.transform)</span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">mapTuple f = f *** f</span></span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pointToRPoint p =</span></span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case mapTuple (toUserUnit defaultDPI) p of</span></span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(Num x, Num y) -> V2 x y</span></span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> error "Reanimate.Svg.svgBoundingPoints: Unrecognized number format."</span></span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">circleBoundingPoints circ =</span></span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let (xnum, ynum) = circ ^. circleCenter</span></span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">rnum = circ ^. circleRadius</span></span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in case mapMaybe unpackNumber [xnum, ynum, rnum] of</span></span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[x, y, r] -> [ V2 (x + r * cos angle) (y + r * sin angle) | angle <- [0, pi/10 .. 2 * pi]]</span></span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> []</span></span>
|
||||
<span class="lineno"> 101 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">ellipseBoundingPoints e =</span></span>
|
||||
<span class="lineno"> 103 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let (xnum,ynum) = e ^. ellipseCenter</span></span>
|
||||
<span class="lineno"> 104 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">xrnum = e ^. ellipseXRadius</span></span>
|
||||
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">yrnum = e ^. ellipseYRadius</span></span>
|
||||
<span class="lineno"> 106 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in case mapMaybe unpackNumber [xnum, ynum, xrnum, yrnum] of</span></span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[x,y,xr,yr] -> [V2 (x + xr * cos angle) (y + yr * sin angle) | angle <- [0, pi/10 .. 2 * pi]]</span></span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> []</span></span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">unpackNumber n =</span></span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case toUserUnit defaultDPI n of</span></span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Num d -> Just d</span></span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> Nothing</span></span></span>
|
||||
<span class="lineno"> 1 </span>{-|
|
||||
<span class="lineno"> 2 </span> Bounding-boxes can be immensely useful for aligning objects
|
||||
<span class="lineno"> 3 </span> but they are not part of the SVG specification and cannot be
|
||||
<span class="lineno"> 4 </span> computed for all SVG nodes. In particular, you'll get bad results
|
||||
<span class="lineno"> 5 </span> when asking for the bounding boxes of Text nodes (because fonts
|
||||
<span class="lineno"> 6 </span> are difficult), clipped nodes, and filtered nodes.
|
||||
<span class="lineno"> 7 </span>-}
|
||||
<span class="lineno"> 8 </span>module Reanimate.Svg.BoundingBox
|
||||
<span class="lineno"> 9 </span> ( boundingBox
|
||||
<span class="lineno"> 10 </span> , svgHeight
|
||||
<span class="lineno"> 11 </span> , svgWidth
|
||||
<span class="lineno"> 12 </span> ) where
|
||||
<span class="lineno"> 13 </span>
|
||||
<span class="lineno"> 14 </span>import Control.Arrow ((***))
|
||||
<span class="lineno"> 15 </span>import Control.Lens ((^.))
|
||||
<span class="lineno"> 16 </span>import Data.List
|
||||
<span class="lineno"> 17 </span>import Data.Maybe (mapMaybe)
|
||||
<span class="lineno"> 18 </span>import Graphics.SvgTree hiding (height, line, path, use,
|
||||
<span class="lineno"> 19 </span> width)
|
||||
<span class="lineno"> 20 </span>import Linear.V2 hiding (angle)
|
||||
<span class="lineno"> 21 </span>import Linear.Vector
|
||||
<span class="lineno"> 22 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 23 </span>import Reanimate.Svg.LineCommand
|
||||
<span class="lineno"> 24 </span>import qualified Reanimate.Transform as Transform
|
||||
<span class="lineno"> 25 </span>-- import qualified Geom2D.CubicBezier as Bezier
|
||||
<span class="lineno"> 26 </span>
|
||||
<span class="lineno"> 27 </span>-- | Return bounding box of SVG tree.
|
||||
<span class="lineno"> 28 </span>-- The four numbers returned are (minimal X-coordinate, minimal Y-coordinate, width, height)
|
||||
<span class="lineno"> 29 </span>--
|
||||
<span class="lineno"> 30 </span>-- Note: Bounding boxes are computed on a best-effort basis and will not work
|
||||
<span class="lineno"> 31 </span>-- in all cases. The only supported SVG nodes are: path, circle, polyline,
|
||||
<span class="lineno"> 32 </span>-- ellipse, line, rectangle, image. All other nodes return (0,0,0,0).
|
||||
<span class="lineno"> 33 </span>boundingBox :: Tree -> (Double, Double, Double, Double)
|
||||
<span class="lineno"> 34 </span><span class="decl"><span class="istickedoff">boundingBox t =</span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"> </span><span class="istickedoff">case svgBoundingPoints t of</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="istickedoff">[] -> (0,0,0,0)</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="istickedoff">(V2 x y:rest) -></span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="istickedoff">let (minx, miny, maxx, maxy) = foldl' worker (x, y, x, y) rest</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="istickedoff">in (minx, miny, maxx-minx, maxy-miny)</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="istickedoff">worker (minx, miny, maxx, maxy) (V2 x y) =</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="istickedoff">(min minx x, min miny y, max maxx x, max maxy y)</span></span>
|
||||
<span class="lineno"> 43 </span>
|
||||
<span class="lineno"> 44 </span>-- | Height of SVG node in local units (not pixels). Computed on best-effort basis
|
||||
<span class="lineno"> 45 </span>-- and will not give accurate results for all SVG nodes.
|
||||
<span class="lineno"> 46 </span>svgHeight :: Tree -> Double
|
||||
<span class="lineno"> 47 </span><span class="decl"><span class="nottickedoff">svgHeight t = h</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="nottickedoff">(_x, _y, _w, h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 50 </span>
|
||||
<span class="lineno"> 51 </span>-- | Width of SVG node in local units (not pixels). Computed on best-effort basis
|
||||
<span class="lineno"> 52 </span>-- and will not give accurate results for all SVG nodes.
|
||||
<span class="lineno"> 53 </span>svgWidth :: Tree -> Double
|
||||
<span class="lineno"> 54 </span><span class="decl"><span class="nottickedoff">svgWidth t = w</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="nottickedoff">(_x, _y, w, _h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 57 </span>
|
||||
<span class="lineno"> 58 </span>-- | Sampling of points in a line path.
|
||||
<span class="lineno"> 59 </span>linePoints :: [LineCommand] -> [RPoint]
|
||||
<span class="lineno"> 60 </span><span class="decl"><span class="nottickedoff">linePoints = worker zero</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="nottickedoff">worker _from [] = []</span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="nottickedoff">worker from (x:xs) =</span>
|
||||
<span class="lineno"> 64 </span><span class="spaces"> </span><span class="nottickedoff">case x of</span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="nottickedoff">LineMove to -> worker to xs</span>
|
||||
<span class="lineno"> 66 </span><span class="spaces"> </span><span class="nottickedoff">-- LineDraw to -> from:to:worker to xs</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="nottickedoff">LineBezier [p] -></span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="nottickedoff">p : worker p xs</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="nottickedoff">LineBezier ctrl -> -- approximation</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="nottickedoff">[ last (partialBezierPoints (from:ctrl) 0 (recip chunks*i)) | i <- [0..chunks]] ++</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="nottickedoff">worker (last ctrl) xs</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="nottickedoff">LineEnd p -> p : worker p xs</span>
|
||||
<span class="lineno"> 73 </span><span class="spaces"> </span><span class="nottickedoff">chunks = 10</span></span>
|
||||
<span class="lineno"> 74 </span>
|
||||
<span class="lineno"> 75 </span>svgBoundingPoints :: Tree -> [RPoint]
|
||||
<span class="lineno"> 76 </span><span class="decl"><span class="istickedoff">svgBoundingPoints t = map (Transform.transformPoint m) $</span>
|
||||
<span class="lineno"> 77 </span><span class="spaces"> </span><span class="istickedoff">case t of</span>
|
||||
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="istickedoff">None -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 79 </span><span class="spaces"> </span><span class="istickedoff">UseTree{} -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="istickedoff">GroupTree g -> concatMap svgBoundingPoints (g^.groupChildren)</span>
|
||||
<span class="lineno"> 81 </span><span class="spaces"> </span><span class="istickedoff">SymbolTree (Symbol g) -> <span class="nottickedoff">concatMap svgBoundingPoints (g^.groupChildren)</span></span>
|
||||
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="istickedoff">FilterTree{} -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="istickedoff">DefinitionTree{} -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="istickedoff">PathTree p -> <span class="nottickedoff">linePoints $ toLineCommands (p^.pathDefinition)</span></span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="istickedoff">CircleTree c -> <span class="nottickedoff">circleBoundingPoints c</span></span>
|
||||
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="istickedoff">PolyLineTree pl -> <span class="nottickedoff">pl ^. polyLinePoints</span></span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="istickedoff">EllipseTree e -> <span class="nottickedoff">ellipseBoundingPoints e</span></span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="istickedoff">LineTree line -> <span class="nottickedoff">map pointToRPoint [line^.linePoint1, line^.linePoint2]</span></span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="istickedoff">RectangleTree rect -></span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case pointToRPoint (rect^.rectUpperLeftCorner) of</span></span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">V2 x y -> V2 x y :</span></span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case mapTuple (fmap $ toUserUnit defaultDPI) (rect^.rectWidth, rect^.rectHeight) of</span></span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(Just (Num w), Just (Num h)) -> [V2 (x+w) (y+h)]</span></span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> []</span></span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="istickedoff">TextTree{} -> []</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="istickedoff">ImageTree img -></span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="istickedoff">case (img^.imageCornerUpperLeft, img^.imageWidth, img^.imageHeight) of</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="istickedoff">((Num x, Num y), Num w, Num h) -></span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="istickedoff">[V2 x y, V2 (x+w) (y+h)]</span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 101 </span><span class="spaces"> </span><span class="istickedoff">MeshGradientTree{} -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 103 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 104 </span><span class="spaces"> </span><span class="istickedoff">m = Transform.mkMatrix (t^.transform)</span>
|
||||
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">mapTuple f = f *** f</span></span>
|
||||
<span class="lineno"> 106 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pointToRPoint p =</span></span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case mapTuple (toUserUnit defaultDPI) p of</span></span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(Num x, Num y) -> V2 x y</span></span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> error "Reanimate.Svg.svgBoundingPoints: Unrecognized number format."</span></span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">circleBoundingPoints circ =</span></span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let (xnum, ynum) = circ ^. circleCenter</span></span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">rnum = circ ^. circleRadius</span></span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in case mapMaybe unpackNumber [xnum, ynum, rnum] of</span></span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[x, y, r] -> [ V2 (x + r * cos angle) (y + r * sin angle) | angle <- [0, pi/10 .. 2 * pi]]</span></span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> []</span></span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">ellipseBoundingPoints e =</span></span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let (xnum,ynum) = e ^. ellipseCenter</span></span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">xrnum = e ^. ellipseXRadius</span></span>
|
||||
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">yrnum = e ^. ellipseYRadius</span></span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in case mapMaybe unpackNumber [xnum, ynum, xrnum, yrnum] of</span></span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[x,y,xr,yr] -> [V2 (x + xr * cos angle) (y + yr * sin angle) | angle <- [0, pi/10 .. 2 * pi]]</span></span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> []</span></span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">unpackNumber n =</span></span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case toUserUnit defaultDPI n of</span></span>
|
||||
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Num d -> Just d</span></span>
|
||||
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -> Nothing</span></span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
|
|
|
|||
|
|
@ -127,309 +127,317 @@ span.spaces { background: white }
|
|||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="nottickedoff">offsetY = -y-h/2</span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="nottickedoff">(x,y,w,h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 110 </span>
|
||||
<span class="lineno"> 111 </span>aroundCenterY :: (Tree -> Tree) -> Tree -> Tree
|
||||
<span class="lineno"> 112 </span><span class="decl"><span class="nottickedoff">aroundCenterY fn t =</span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="nottickedoff">translate 0 (-offsetY) $ fn $ translate 0 offsetY t</span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="nottickedoff">offsetY = -y-h/2</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="nottickedoff">(_x,y,_w,h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 117 </span>
|
||||
<span class="lineno"> 118 </span>aroundCenterX :: (Tree -> Tree) -> Tree -> Tree
|
||||
<span class="lineno"> 119 </span><span class="decl"><span class="nottickedoff">aroundCenterX fn t =</span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="nottickedoff">translate (-offsetX) 0 $ fn $ translate offsetX 0 t</span>
|
||||
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="nottickedoff">offsetX = -x-w/2</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="nottickedoff">(x,_y,w,_h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 124 </span>
|
||||
<span class="lineno"> 125 </span>-- | Scale the image uniformly by given factor along both X and Y axes.
|
||||
<span class="lineno"> 126 </span>-- For example @scale 2 image@ makes the image twice as large, while @scale 0.5 image@ makes it
|
||||
<span class="lineno"> 127 </span>-- half the original size. Negative values are also allowed, and lead to flipping the image along
|
||||
<span class="lineno"> 128 </span>-- both X and Y axes.
|
||||
<span class="lineno"> 129 </span>scale :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 130 </span><span class="decl"><span class="istickedoff">scale a = withTransformations [Scale a Nothing]</span></span>
|
||||
<span class="lineno"> 131 </span>
|
||||
<span class="lineno"> 132 </span>-- | @scaleToSize width height@ resizes the image so that its bounding box has corresponding @width@
|
||||
<span class="lineno"> 133 </span>-- and @height@.
|
||||
<span class="lineno"> 134 </span>scaleToSize :: Double -> Double -> Tree -> Tree
|
||||
<span class="lineno"> 135 </span><span class="decl"><span class="istickedoff">scaleToSize w h t =</span>
|
||||
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="istickedoff">scaleXY (w/w') (h/h') t</span>
|
||||
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="istickedoff">(_x, _y, w', h') = boundingBox t</span></span>
|
||||
<span class="lineno"> 139 </span>
|
||||
<span class="lineno"> 140 </span>-- | @scaleToWidth width@ scales the image so that the width of its bounding box ends up having
|
||||
<span class="lineno"> 141 </span>-- given @width@.
|
||||
<span class="lineno"> 142 </span>scaleToWidth :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 143 </span><span class="decl"><span class="istickedoff">scaleToWidth w t =</span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="istickedoff">scale (w/w') t</span>
|
||||
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="istickedoff">(_x, _y, w', _h') = boundingBox t</span></span>
|
||||
<span class="lineno"> 147 </span>
|
||||
<span class="lineno"> 148 </span>-- | @scaleToHeight height@ scales the image so that the height of its bounding box ends up having
|
||||
<span class="lineno"> 149 </span>-- given @height@.
|
||||
<span class="lineno"> 150 </span>scaleToHeight :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 151 </span><span class="decl"><span class="nottickedoff">scaleToHeight h t =</span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="nottickedoff">scale (h/h') t</span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="nottickedoff">(_x, _y, _w', h') = boundingBox t</span></span>
|
||||
<span class="lineno"> 155 </span>
|
||||
<span class="lineno"> 156 </span>-- | Similar to 'scale', except scale factors for X and Y axes are specified separately.
|
||||
<span class="lineno"> 157 </span>scaleXY :: Double -> Double -> Tree -> Tree
|
||||
<span class="lineno"> 158 </span><span class="decl"><span class="istickedoff">scaleXY x y = withTransformations [Scale x (Just y)]</span></span>
|
||||
<span class="lineno"> 159 </span>
|
||||
<span class="lineno"> 160 </span>
|
||||
<span class="lineno"> 161 </span>-- | Flip the image along vertical axis so that what was on the right will end up on left and vice
|
||||
<span class="lineno"> 162 </span>-- versa.
|
||||
<span class="lineno"> 163 </span>flipXAxis :: Tree -> Tree
|
||||
<span class="lineno"> 164 </span><span class="decl"><span class="istickedoff">flipXAxis = scaleXY (-1) 1</span></span>
|
||||
<span class="lineno"> 165 </span>
|
||||
<span class="lineno"> 166 </span>-- | Flip the image along horizontal so that what was on the top will end up in the bottom and vice
|
||||
<span class="lineno"> 167 </span>-- versa.
|
||||
<span class="lineno"> 168 </span>flipYAxis :: Tree -> Tree
|
||||
<span class="lineno"> 169 </span><span class="decl"><span class="istickedoff">flipYAxis = scaleXY 1 (-1)</span></span>
|
||||
<span class="lineno"> 170 </span>
|
||||
<span class="lineno"> 171 </span>-- | Translate given image so that the center of its bouding box coincides with coordinates
|
||||
<span class="lineno"> 172 </span>-- @(0, 0)@.
|
||||
<span class="lineno"> 173 </span>center :: Tree -> Tree
|
||||
<span class="lineno"> 174 </span><span class="decl"><span class="istickedoff">center t = centerUsing t t</span></span>
|
||||
<span class="lineno"> 175 </span>
|
||||
<span class="lineno"> 176 </span>-- | Translate given image so that the X-coordinate of the center of its bouding box is 0.
|
||||
<span class="lineno"> 177 </span>centerX :: Tree -> Tree
|
||||
<span class="lineno"> 178 </span><span class="decl"><span class="nottickedoff">centerX t = translate (-x-w/2) 0 t</span>
|
||||
<span class="lineno"> 179 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 180 </span><span class="spaces"> </span><span class="nottickedoff">(x, _y, w, _h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 181 </span>
|
||||
<span class="lineno"> 182 </span>-- | Translate given image so that the Y-coordinate of the center of its bouding box is 0.
|
||||
<span class="lineno"> 183 </span>centerY :: Tree -> Tree
|
||||
<span class="lineno"> 184 </span><span class="decl"><span class="nottickedoff">centerY t = translate 0 (-y-h/2) t</span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="nottickedoff">(_x, y, _w, h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 187 </span>
|
||||
<span class="lineno"> 188 </span>centerUsing :: Tree -> Tree -> Tree
|
||||
<span class="lineno"> 189 </span><span class="decl"><span class="istickedoff">centerUsing a = translate (-x-w/2) (-y-h/2)</span>
|
||||
<span class="lineno"> 190 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 191 </span><span class="spaces"> </span><span class="istickedoff">(x, y, w, h) = boundingBox a</span></span>
|
||||
<span class="lineno"> 192 </span>
|
||||
<span class="lineno"> 193 </span>-- | Create 'Texture' based on SVG color name.
|
||||
<span class="lineno"> 194 </span>-- See <https://en.wikipedia.org/wiki/Web_colors#X11_color_names> for the list of available names.
|
||||
<span class="lineno"> 195 </span>-- If the provided name doesn't correspond to valid SVG color name, white-ish color is used.
|
||||
<span class="lineno"> 196 </span>mkColor :: String -> Texture
|
||||
<span class="lineno"> 197 </span><span class="decl"><span class="istickedoff">mkColor name =</span>
|
||||
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="istickedoff">case Map.lookup (T.pack name) svgNamedColors of</span>
|
||||
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="istickedoff">Nothing -> <span class="nottickedoff">ColorRef (PixelRGBA8 240 248 255 255)</span></span>
|
||||
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="istickedoff">Just c -> ColorRef c</span></span>
|
||||
<span class="lineno"> 201 </span>
|
||||
<span class="lineno"> 202 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>
|
||||
<span class="lineno"> 203 </span>withStrokeColor :: String -> Tree -> Tree
|
||||
<span class="lineno"> 204 </span><span class="decl"><span class="istickedoff">withStrokeColor color = strokeColor .~ pure (mkColor color)</span></span>
|
||||
<span class="lineno"> 205 </span>
|
||||
<span class="lineno"> 206 </span>withStrokeColorPixel :: PixelRGBA8 -> Tree -> Tree
|
||||
<span class="lineno"> 207 </span><span class="decl"><span class="istickedoff">withStrokeColorPixel color = strokeColor .~ pure (ColorRef color)</span></span>
|
||||
<span class="lineno"> 111 </span>-- | Same as 'aroundCenter' but only for the Y-axis.
|
||||
<span class="lineno"> 112 </span>aroundCenterY :: (Tree -> Tree) -> Tree -> Tree
|
||||
<span class="lineno"> 113 </span><span class="decl"><span class="nottickedoff">aroundCenterY fn t =</span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="nottickedoff">translate 0 (-offsetY) $ fn $ translate 0 offsetY t</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="nottickedoff">offsetY = -y-h/2</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="nottickedoff">(_x,y,_w,h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 118 </span>
|
||||
<span class="lineno"> 119 </span>-- | Same as 'aroundCenter' but only for the X-axis.
|
||||
<span class="lineno"> 120 </span>aroundCenterX :: (Tree -> Tree) -> Tree -> Tree
|
||||
<span class="lineno"> 121 </span><span class="decl"><span class="nottickedoff">aroundCenterX fn t =</span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="nottickedoff">translate (-offsetX) 0 $ fn $ translate offsetX 0 t</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="nottickedoff">offsetX = -x-w/2</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="nottickedoff">(x,_y,w,_h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 126 </span>
|
||||
<span class="lineno"> 127 </span>-- | Scale the image uniformly by given factor along both X and Y axes.
|
||||
<span class="lineno"> 128 </span>-- For example @scale 2 image@ makes the image twice as large, while @scale 0.5 image@ makes it
|
||||
<span class="lineno"> 129 </span>-- half the original size. Negative values are also allowed, and lead to flipping the image along
|
||||
<span class="lineno"> 130 </span>-- both X and Y axes.
|
||||
<span class="lineno"> 131 </span>scale :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 132 </span><span class="decl"><span class="istickedoff">scale a = withTransformations [Scale a Nothing]</span></span>
|
||||
<span class="lineno"> 133 </span>
|
||||
<span class="lineno"> 134 </span>-- | @scaleToSize width height@ resizes the image so that its bounding box has corresponding @width@
|
||||
<span class="lineno"> 135 </span>-- and @height@.
|
||||
<span class="lineno"> 136 </span>scaleToSize :: Double -> Double -> Tree -> Tree
|
||||
<span class="lineno"> 137 </span><span class="decl"><span class="istickedoff">scaleToSize w h t =</span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="istickedoff">scaleXY (w/w') (h/h') t</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="istickedoff">(_x, _y, w', h') = boundingBox t</span></span>
|
||||
<span class="lineno"> 141 </span>
|
||||
<span class="lineno"> 142 </span>-- | @scaleToWidth width@ scales the image so that the width of its bounding box ends up having
|
||||
<span class="lineno"> 143 </span>-- given @width@.
|
||||
<span class="lineno"> 144 </span>scaleToWidth :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 145 </span><span class="decl"><span class="istickedoff">scaleToWidth w t =</span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="istickedoff">scale (w/w') t</span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="istickedoff">(_x, _y, w', _h') = boundingBox t</span></span>
|
||||
<span class="lineno"> 149 </span>
|
||||
<span class="lineno"> 150 </span>-- | @scaleToHeight height@ scales the image so that the height of its bounding box ends up having
|
||||
<span class="lineno"> 151 </span>-- given @height@.
|
||||
<span class="lineno"> 152 </span>scaleToHeight :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 153 </span><span class="decl"><span class="nottickedoff">scaleToHeight h t =</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="nottickedoff">scale (h/h') t</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="nottickedoff">(_x, _y, _w', h') = boundingBox t</span></span>
|
||||
<span class="lineno"> 157 </span>
|
||||
<span class="lineno"> 158 </span>-- | Similar to 'scale', except scale factors for X and Y axes are specified separately.
|
||||
<span class="lineno"> 159 </span>scaleXY :: Double -> Double -> Tree -> Tree
|
||||
<span class="lineno"> 160 </span><span class="decl"><span class="istickedoff">scaleXY x y = withTransformations [Scale x (Just y)]</span></span>
|
||||
<span class="lineno"> 161 </span>
|
||||
<span class="lineno"> 162 </span>
|
||||
<span class="lineno"> 163 </span>-- | Flip the image along vertical axis so that what was on the right will end up on left and vice
|
||||
<span class="lineno"> 164 </span>-- versa.
|
||||
<span class="lineno"> 165 </span>flipXAxis :: Tree -> Tree
|
||||
<span class="lineno"> 166 </span><span class="decl"><span class="istickedoff">flipXAxis = scaleXY (-1) 1</span></span>
|
||||
<span class="lineno"> 167 </span>
|
||||
<span class="lineno"> 168 </span>-- | Flip the image along horizontal so that what was on the top will end up in the bottom and vice
|
||||
<span class="lineno"> 169 </span>-- versa.
|
||||
<span class="lineno"> 170 </span>flipYAxis :: Tree -> Tree
|
||||
<span class="lineno"> 171 </span><span class="decl"><span class="istickedoff">flipYAxis = scaleXY 1 (-1)</span></span>
|
||||
<span class="lineno"> 172 </span>
|
||||
<span class="lineno"> 173 </span>-- | Translate given image so that the center of its bouding box coincides with coordinates
|
||||
<span class="lineno"> 174 </span>-- @(0, 0)@.
|
||||
<span class="lineno"> 175 </span>center :: Tree -> Tree
|
||||
<span class="lineno"> 176 </span><span class="decl"><span class="istickedoff">center t = centerUsing t t</span></span>
|
||||
<span class="lineno"> 177 </span>
|
||||
<span class="lineno"> 178 </span>-- | Translate given image so that the X-coordinate of the center of its bouding box is 0.
|
||||
<span class="lineno"> 179 </span>centerX :: Tree -> Tree
|
||||
<span class="lineno"> 180 </span><span class="decl"><span class="nottickedoff">centerX t = translate (-x-w/2) 0 t</span>
|
||||
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 182 </span><span class="spaces"> </span><span class="nottickedoff">(x, _y, w, _h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 183 </span>
|
||||
<span class="lineno"> 184 </span>-- | Translate given image so that the Y-coordinate of the center of its bouding box is 0.
|
||||
<span class="lineno"> 185 </span>centerY :: Tree -> Tree
|
||||
<span class="lineno"> 186 </span><span class="decl"><span class="nottickedoff">centerY t = translate 0 (-y-h/2) t</span>
|
||||
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="nottickedoff">(_x, y, _w, h) = boundingBox t</span></span>
|
||||
<span class="lineno"> 189 </span>
|
||||
<span class="lineno"> 190 </span>-- | Center the second argument using the bounding-box of the first.
|
||||
<span class="lineno"> 191 </span>centerUsing :: Tree -> Tree -> Tree
|
||||
<span class="lineno"> 192 </span><span class="decl"><span class="istickedoff">centerUsing a = translate (-x-w/2) (-y-h/2)</span>
|
||||
<span class="lineno"> 193 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="istickedoff">(x, y, w, h) = boundingBox a</span></span>
|
||||
<span class="lineno"> 195 </span>
|
||||
<span class="lineno"> 196 </span>-- | Create 'Texture' based on SVG color name.
|
||||
<span class="lineno"> 197 </span>-- See <https://en.wikipedia.org/wiki/Web_colors#X11_color_names> for the list of available names.
|
||||
<span class="lineno"> 198 </span>-- If the provided name doesn't correspond to valid SVG color name, white-ish color is used.
|
||||
<span class="lineno"> 199 </span>mkColor :: String -> Texture
|
||||
<span class="lineno"> 200 </span><span class="decl"><span class="istickedoff">mkColor name =</span>
|
||||
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="istickedoff">case Map.lookup (T.pack name) svgNamedColors of</span>
|
||||
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="istickedoff">Nothing -> <span class="nottickedoff">ColorRef (PixelRGBA8 240 248 255 255)</span></span>
|
||||
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="istickedoff">Just c -> ColorRef c</span></span>
|
||||
<span class="lineno"> 204 </span>
|
||||
<span class="lineno"> 205 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>
|
||||
<span class="lineno"> 206 </span>withStrokeColor :: String -> Tree -> Tree
|
||||
<span class="lineno"> 207 </span><span class="decl"><span class="istickedoff">withStrokeColor color = strokeColor .~ pure (mkColor color)</span></span>
|
||||
<span class="lineno"> 208 </span>
|
||||
<span class="lineno"> 209 </span>withStrokeDashArray :: [Double] -> Tree -> Tree
|
||||
<span class="lineno"> 210 </span><span class="decl"><span class="nottickedoff">withStrokeDashArray arr = strokeDashArray .~ pure (map Num arr)</span></span>
|
||||
<span class="lineno"> 211 </span>
|
||||
<span class="lineno"> 212 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-linejoin>
|
||||
<span class="lineno"> 213 </span>withStrokeLineJoin :: LineJoin -> Tree -> Tree
|
||||
<span class="lineno"> 214 </span><span class="decl"><span class="nottickedoff">withStrokeLineJoin ljoin = strokeLineJoin .~ pure ljoin</span></span>
|
||||
<span class="lineno"> 215 </span>
|
||||
<span class="lineno"> 216 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>
|
||||
<span class="lineno"> 217 </span>withFillColor :: String -> Tree -> Tree
|
||||
<span class="lineno"> 218 </span><span class="decl"><span class="istickedoff">withFillColor color = fillColor .~ pure (mkColor color)</span></span>
|
||||
<span class="lineno"> 219 </span>
|
||||
<span class="lineno"> 220 </span>withFillColorPixel :: PixelRGBA8 -> Tree -> Tree
|
||||
<span class="lineno"> 221 </span><span class="decl"><span class="istickedoff">withFillColorPixel color = fillColor .~ pure (ColorRef color)</span></span>
|
||||
<span class="lineno"> 222 </span>
|
||||
<span class="lineno"> 223 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill-opacity>
|
||||
<span class="lineno"> 224 </span>withFillOpacity :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 225 </span><span class="decl"><span class="istickedoff">withFillOpacity opacity = fillOpacity ?~ realToFrac opacity</span></span>
|
||||
<span class="lineno"> 226 </span>
|
||||
<span class="lineno"> 227 </span>withGroupOpacity :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 228 </span><span class="decl"><span class="istickedoff">withGroupOpacity opacity = groupOpacity ?~ realToFrac opacity</span></span>
|
||||
<span class="lineno"> 229 </span>
|
||||
<span class="lineno"> 230 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-width>
|
||||
<span class="lineno"> 231 </span>withStrokeWidth :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 232 </span><span class="decl"><span class="istickedoff">withStrokeWidth width = strokeWidth .~ pure (Num width)</span></span>
|
||||
<span class="lineno"> 233 </span>
|
||||
<span class="lineno"> 234 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/clip-path>
|
||||
<span class="lineno"> 235 </span>withClipPathRef :: ElementRef -- ^ Reference to clip path defined previously (e.g. by 'mkClipPath')
|
||||
<span class="lineno"> 236 </span> -> Tree -- ^ Image that will be clipped by the referenced clip path
|
||||
<span class="lineno"> 237 </span> -> Tree
|
||||
<span class="lineno"> 238 </span><span class="decl"><span class="nottickedoff">withClipPathRef ref sub = mkGroup [sub] & clipPathRef .~ pure ref</span></span>
|
||||
<span class="lineno"> 239 </span>
|
||||
<span class="lineno"> 240 </span>-- | Assigns ID attribute to given image.
|
||||
<span class="lineno"> 241 </span>withId :: String -> Tree -> Tree
|
||||
<span class="lineno"> 242 </span><span class="decl"><span class="nottickedoff">withId idTag = attrId ?~ idTag</span></span>
|
||||
<span class="lineno"> 243 </span>
|
||||
<span class="lineno"> 244 </span>-- | @mkRect width height@ creates a rectangle with given @with@ and @height@, centered at @(0, 0)@.
|
||||
<span class="lineno"> 245 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/rect>
|
||||
<span class="lineno"> 246 </span>mkRect :: Double -> Double -> Tree
|
||||
<span class="lineno"> 247 </span><span class="decl"><span class="istickedoff">mkRect width height = translate (-width/2) (-height/2) $ RectangleTree $ defaultSvg</span>
|
||||
<span class="lineno"> 248 </span><span class="spaces"> </span><span class="istickedoff">& rectUpperLeftCorner .~ (Num 0, Num 0)</span>
|
||||
<span class="lineno"> 249 </span><span class="spaces"> </span><span class="istickedoff">& rectWidth ?~ Num width</span>
|
||||
<span class="lineno"> 250 </span><span class="spaces"> </span><span class="istickedoff">& rectHeight ?~ Num height</span></span>
|
||||
<span class="lineno"> 251 </span>
|
||||
<span class="lineno"> 252 </span>-- | Create a circle with given radius, centered at @(0, 0)@.
|
||||
<span class="lineno"> 253 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/circle>
|
||||
<span class="lineno"> 254 </span>mkCircle :: Double -> Tree
|
||||
<span class="lineno"> 255 </span><span class="decl"><span class="istickedoff">mkCircle radius = CircleTree $ defaultSvg</span>
|
||||
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="istickedoff">& circleCenter .~ (Num 0, Num 0)</span>
|
||||
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="istickedoff">& circleRadius .~ Num radius</span></span>
|
||||
<span class="lineno"> 209 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>
|
||||
<span class="lineno"> 210 </span>withStrokeColorPixel :: PixelRGBA8 -> Tree -> Tree
|
||||
<span class="lineno"> 211 </span><span class="decl"><span class="istickedoff">withStrokeColorPixel color = strokeColor .~ pure (ColorRef color)</span></span>
|
||||
<span class="lineno"> 212 </span>
|
||||
<span class="lineno"> 213 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-dasharray>
|
||||
<span class="lineno"> 214 </span>withStrokeDashArray :: [Double] -> Tree -> Tree
|
||||
<span class="lineno"> 215 </span><span class="decl"><span class="nottickedoff">withStrokeDashArray arr = strokeDashArray .~ pure (map Num arr)</span></span>
|
||||
<span class="lineno"> 216 </span>
|
||||
<span class="lineno"> 217 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-linejoin>
|
||||
<span class="lineno"> 218 </span>withStrokeLineJoin :: LineJoin -> Tree -> Tree
|
||||
<span class="lineno"> 219 </span><span class="decl"><span class="nottickedoff">withStrokeLineJoin ljoin = strokeLineJoin .~ pure ljoin</span></span>
|
||||
<span class="lineno"> 220 </span>
|
||||
<span class="lineno"> 221 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>
|
||||
<span class="lineno"> 222 </span>withFillColor :: String -> Tree -> Tree
|
||||
<span class="lineno"> 223 </span><span class="decl"><span class="istickedoff">withFillColor color = fillColor .~ pure (mkColor color)</span></span>
|
||||
<span class="lineno"> 224 </span>
|
||||
<span class="lineno"> 225 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>
|
||||
<span class="lineno"> 226 </span>withFillColorPixel :: PixelRGBA8 -> Tree -> Tree
|
||||
<span class="lineno"> 227 </span><span class="decl"><span class="istickedoff">withFillColorPixel color = fillColor .~ pure (ColorRef color)</span></span>
|
||||
<span class="lineno"> 228 </span>
|
||||
<span class="lineno"> 229 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill-opacity>
|
||||
<span class="lineno"> 230 </span>withFillOpacity :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 231 </span><span class="decl"><span class="istickedoff">withFillOpacity opacity = fillOpacity ?~ realToFrac opacity</span></span>
|
||||
<span class="lineno"> 232 </span>
|
||||
<span class="lineno"> 233 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/opacity>
|
||||
<span class="lineno"> 234 </span>withGroupOpacity :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 235 </span><span class="decl"><span class="istickedoff">withGroupOpacity opacity = groupOpacity ?~ realToFrac opacity</span></span>
|
||||
<span class="lineno"> 236 </span>
|
||||
<span class="lineno"> 237 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-width>
|
||||
<span class="lineno"> 238 </span>withStrokeWidth :: Double -> Tree -> Tree
|
||||
<span class="lineno"> 239 </span><span class="decl"><span class="istickedoff">withStrokeWidth width = strokeWidth .~ pure (Num width)</span></span>
|
||||
<span class="lineno"> 240 </span>
|
||||
<span class="lineno"> 241 </span>-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/clip-path>
|
||||
<span class="lineno"> 242 </span>withClipPathRef :: ElementRef -- ^ Reference to clip path defined previously (e.g. by 'mkClipPath')
|
||||
<span class="lineno"> 243 </span> -> Tree -- ^ Image that will be clipped by the referenced clip path
|
||||
<span class="lineno"> 244 </span> -> Tree
|
||||
<span class="lineno"> 245 </span><span class="decl"><span class="nottickedoff">withClipPathRef ref sub = mkGroup [sub] & clipPathRef .~ pure ref</span></span>
|
||||
<span class="lineno"> 246 </span>
|
||||
<span class="lineno"> 247 </span>-- | Assigns ID attribute to given image.
|
||||
<span class="lineno"> 248 </span>withId :: String -> Tree -> Tree
|
||||
<span class="lineno"> 249 </span><span class="decl"><span class="nottickedoff">withId idTag = attrId ?~ idTag</span></span>
|
||||
<span class="lineno"> 250 </span>
|
||||
<span class="lineno"> 251 </span>-- | @mkRect width height@ creates a rectangle with given @with@ and @height@, centered at @(0, 0)@.
|
||||
<span class="lineno"> 252 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/rect>
|
||||
<span class="lineno"> 253 </span>mkRect :: Double -> Double -> Tree
|
||||
<span class="lineno"> 254 </span><span class="decl"><span class="istickedoff">mkRect width height = translate (-width/2) (-height/2) $ RectangleTree $ defaultSvg</span>
|
||||
<span class="lineno"> 255 </span><span class="spaces"> </span><span class="istickedoff">& rectUpperLeftCorner .~ (Num 0, Num 0)</span>
|
||||
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="istickedoff">& rectWidth ?~ Num width</span>
|
||||
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="istickedoff">& rectHeight ?~ Num height</span></span>
|
||||
<span class="lineno"> 258 </span>
|
||||
<span class="lineno"> 259 </span>-- | Create an ellipse given X-axis radius, and Y-axis radius, with center at @(0, 0)@.
|
||||
<span class="lineno"> 260 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/ellipse>
|
||||
<span class="lineno"> 261 </span>mkEllipse :: Double -> Double -> Tree
|
||||
<span class="lineno"> 262 </span><span class="decl"><span class="istickedoff">mkEllipse rx ry = EllipseTree $ defaultSvg</span>
|
||||
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="istickedoff">& ellipseCenter .~ (Num 0, Num 0)</span>
|
||||
<span class="lineno"> 264 </span><span class="spaces"> </span><span class="istickedoff">& ellipseXRadius .~ Num rx</span>
|
||||
<span class="lineno"> 265 </span><span class="spaces"> </span><span class="istickedoff">& ellipseYRadius .~ Num ry</span></span>
|
||||
<span class="lineno"> 266 </span>
|
||||
<span class="lineno"> 267 </span>-- | Create a line segment between two points given by their @(x, y)@ coordinates.
|
||||
<span class="lineno"> 268 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/line>
|
||||
<span class="lineno"> 269 </span>mkLine :: (Double,Double) -> (Double, Double) -> Tree
|
||||
<span class="lineno"> 270 </span><span class="decl"><span class="istickedoff">mkLine (x1,y1) (x2,y2) = LineTree $ defaultSvg</span>
|
||||
<span class="lineno"> 271 </span><span class="spaces"> </span><span class="istickedoff">& linePoint1 .~ (Num x1, Num y1)</span>
|
||||
<span class="lineno"> 272 </span><span class="spaces"> </span><span class="istickedoff">& linePoint2 .~ (Num x2, Num y2)</span></span>
|
||||
<span class="lineno"> 259 </span>-- | Create a circle with given radius, centered at @(0, 0)@.
|
||||
<span class="lineno"> 260 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/circle>
|
||||
<span class="lineno"> 261 </span>mkCircle :: Double -> Tree
|
||||
<span class="lineno"> 262 </span><span class="decl"><span class="istickedoff">mkCircle radius = CircleTree $ defaultSvg</span>
|
||||
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="istickedoff">& circleCenter .~ (Num 0, Num 0)</span>
|
||||
<span class="lineno"> 264 </span><span class="spaces"> </span><span class="istickedoff">& circleRadius .~ Num radius</span></span>
|
||||
<span class="lineno"> 265 </span>
|
||||
<span class="lineno"> 266 </span>-- | Create an ellipse given X-axis radius, and Y-axis radius, with center at @(0, 0)@.
|
||||
<span class="lineno"> 267 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/ellipse>
|
||||
<span class="lineno"> 268 </span>mkEllipse :: Double -> Double -> Tree
|
||||
<span class="lineno"> 269 </span><span class="decl"><span class="istickedoff">mkEllipse rx ry = EllipseTree $ defaultSvg</span>
|
||||
<span class="lineno"> 270 </span><span class="spaces"> </span><span class="istickedoff">& ellipseCenter .~ (Num 0, Num 0)</span>
|
||||
<span class="lineno"> 271 </span><span class="spaces"> </span><span class="istickedoff">& ellipseXRadius .~ Num rx</span>
|
||||
<span class="lineno"> 272 </span><span class="spaces"> </span><span class="istickedoff">& ellipseYRadius .~ Num ry</span></span>
|
||||
<span class="lineno"> 273 </span>
|
||||
<span class="lineno"> 274 </span>-- | Merges multiple images into one.
|
||||
<span class="lineno"> 275 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/g>
|
||||
<span class="lineno"> 276 </span>mkGroup :: [Tree] -> Tree
|
||||
<span class="lineno"> 277 </span><span class="decl"><span class="istickedoff">mkGroup forest = GroupTree $ defaultSvg</span>
|
||||
<span class="lineno"> 278 </span><span class="spaces"> </span><span class="istickedoff">& groupChildren .~ forest</span></span>
|
||||
<span class="lineno"> 279 </span>
|
||||
<span class="lineno"> 280 </span>-- | Create definition of graphical objects that can be used at later time.
|
||||
<span class="lineno"> 281 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/defs>
|
||||
<span class="lineno"> 282 </span>mkDefinitions :: [Tree] -> Tree
|
||||
<span class="lineno"> 283 </span><span class="decl"><span class="nottickedoff">mkDefinitions forest = DefinitionTree $ defaultSvg</span>
|
||||
<span class="lineno"> 284 </span><span class="spaces"> </span><span class="nottickedoff">& groupChildren .~ forest</span></span>
|
||||
<span class="lineno"> 285 </span>
|
||||
<span class="lineno"> 286 </span>-- | Create an element by referring to existing element defined previously.
|
||||
<span class="lineno"> 287 </span>-- For example you can create a graphical element, assign ID to it using 'withId', wrap it in
|
||||
<span class="lineno"> 288 </span>-- 'mkDefinitions' and then use it via @use "myId"@.
|
||||
<span class="lineno"> 289 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/use>
|
||||
<span class="lineno"> 290 </span>mkUse :: String -> Tree
|
||||
<span class="lineno"> 291 </span><span class="decl"><span class="nottickedoff">mkUse name = UseTree (defaultSvg & useName .~ name) Nothing</span></span>
|
||||
<span class="lineno"> 274 </span>-- | Create a line segment between two points given by their @(x, y)@ coordinates.
|
||||
<span class="lineno"> 275 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/line>
|
||||
<span class="lineno"> 276 </span>mkLine :: (Double,Double) -> (Double, Double) -> Tree
|
||||
<span class="lineno"> 277 </span><span class="decl"><span class="istickedoff">mkLine (x1,y1) (x2,y2) = LineTree $ defaultSvg</span>
|
||||
<span class="lineno"> 278 </span><span class="spaces"> </span><span class="istickedoff">& linePoint1 .~ (Num x1, Num y1)</span>
|
||||
<span class="lineno"> 279 </span><span class="spaces"> </span><span class="istickedoff">& linePoint2 .~ (Num x2, Num y2)</span></span>
|
||||
<span class="lineno"> 280 </span>
|
||||
<span class="lineno"> 281 </span>-- | Merges multiple images into one.
|
||||
<span class="lineno"> 282 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/g>
|
||||
<span class="lineno"> 283 </span>mkGroup :: [Tree] -> Tree
|
||||
<span class="lineno"> 284 </span><span class="decl"><span class="istickedoff">mkGroup forest = GroupTree $ defaultSvg</span>
|
||||
<span class="lineno"> 285 </span><span class="spaces"> </span><span class="istickedoff">& groupChildren .~ forest</span></span>
|
||||
<span class="lineno"> 286 </span>
|
||||
<span class="lineno"> 287 </span>-- | Create definition of graphical objects that can be used at later time.
|
||||
<span class="lineno"> 288 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/defs>
|
||||
<span class="lineno"> 289 </span>mkDefinitions :: [Tree] -> Tree
|
||||
<span class="lineno"> 290 </span><span class="decl"><span class="nottickedoff">mkDefinitions forest = DefinitionTree $ defaultSvg</span>
|
||||
<span class="lineno"> 291 </span><span class="spaces"> </span><span class="nottickedoff">& groupChildren .~ forest</span></span>
|
||||
<span class="lineno"> 292 </span>
|
||||
<span class="lineno"> 293 </span>-- | A clip path restricts the region to which paint can be applied.
|
||||
<span class="lineno"> 294 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/clipPath>
|
||||
<span class="lineno"> 295 </span>mkClipPath :: String -- ^ ID of the clip path, which can then be referred to by other elements
|
||||
<span class="lineno"> 296 </span> -- using 'withClipPathRef'.
|
||||
<span class="lineno"> 297 </span> -> [Tree] -- ^ List of shapes that will determine the final shape of the clipping region
|
||||
<span class="lineno"> 298 </span> -> Tree
|
||||
<span class="lineno"> 299 </span><span class="decl"><span class="nottickedoff">mkClipPath idTag forest = withId idTag $ ClipPathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 300 </span><span class="spaces"> </span><span class="nottickedoff">& clipPathContent .~ forest</span></span>
|
||||
<span class="lineno"> 301 </span>
|
||||
<span class="lineno"> 302 </span>-- | Create a path from the list of path commands.
|
||||
<span class="lineno"> 303 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d#Path_commands>
|
||||
<span class="lineno"> 304 </span>mkPath :: [PathCommand] -> Tree
|
||||
<span class="lineno"> 305 </span><span class="decl"><span class="istickedoff">mkPath cmds = PathTree $ defaultSvg & pathDefinition .~ cmds</span></span>
|
||||
<span class="lineno"> 306 </span>
|
||||
<span class="lineno"> 307 </span>-- | Similar to 'mkPathText', but taking SVG path command as a String.
|
||||
<span class="lineno"> 308 </span>mkPathString :: String -> Tree
|
||||
<span class="lineno"> 309 </span><span class="decl"><span class="istickedoff">mkPathString = mkPathText . T.pack</span></span>
|
||||
<span class="lineno"> 310 </span>
|
||||
<span class="lineno"> 311 </span>-- | Create path from textual representation of SVG path command.
|
||||
<span class="lineno"> 312 </span>-- If the text doesn't represent valid path command, this function fails with 'Prelude.error'.
|
||||
<span class="lineno"> 313 </span>-- Use 'mkPath' for type safe way of creating paths.
|
||||
<span class="lineno"> 314 </span>mkPathText :: T.Text -> Tree
|
||||
<span class="lineno"> 315 </span><span class="decl"><span class="istickedoff">mkPathText str =</span>
|
||||
<span class="lineno"> 316 </span><span class="spaces"> </span><span class="istickedoff">case parseOnly pathParser str of</span>
|
||||
<span class="lineno"> 317 </span><span class="spaces"> </span><span class="istickedoff">Left err -> <span class="nottickedoff">error err</span></span>
|
||||
<span class="lineno"> 318 </span><span class="spaces"> </span><span class="istickedoff">Right cmds -> mkPath cmds</span></span>
|
||||
<span class="lineno"> 319 </span>
|
||||
<span class="lineno"> 320 </span>-- | Create a path from a list of @(x, y)@ coordinates of points along the path.
|
||||
<span class="lineno"> 321 </span>mkLinePath :: [(Double, Double)] -> Tree
|
||||
<span class="lineno"> 322 </span><span class="decl"><span class="nottickedoff">mkLinePath [] = mkGroup []</span>
|
||||
<span class="lineno"> 323 </span><span class="spaces"></span><span class="nottickedoff">mkLinePath ((startX, startY):rest) =</span>
|
||||
<span class="lineno"> 324 </span><span class="spaces"> </span><span class="nottickedoff">PathTree $ defaultSvg & pathDefinition .~ cmds</span>
|
||||
<span class="lineno"> 325 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 326 </span><span class="spaces"> </span><span class="nottickedoff">cmds = [ MoveTo OriginAbsolute [V2 startX startY]</span>
|
||||
<span class="lineno"> 327 </span><span class="spaces"> </span><span class="nottickedoff">, LineTo OriginAbsolute [ V2 x y | (x, y) <- rest ] ]</span></span>
|
||||
<span class="lineno"> 328 </span>
|
||||
<span class="lineno"> 329 </span>-- | Create a path from a list of @(x, y)@ coordinates of points along the path.
|
||||
<span class="lineno"> 330 </span>mkLinePathClosed :: [(Double, Double)] -> Tree
|
||||
<span class="lineno"> 331 </span><span class="decl"><span class="istickedoff">mkLinePathClosed [] = <span class="nottickedoff">mkGroup []</span></span>
|
||||
<span class="lineno"> 332 </span><span class="spaces"></span><span class="istickedoff">mkLinePathClosed ((startX, startY):rest) =</span>
|
||||
<span class="lineno"> 333 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg & pathDefinition .~ cmds</span>
|
||||
<span class="lineno"> 334 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 335 </span><span class="spaces"> </span><span class="istickedoff">cmds = [ MoveTo OriginAbsolute [V2 startX startY]</span>
|
||||
<span class="lineno"> 336 </span><span class="spaces"> </span><span class="istickedoff">, LineTo OriginAbsolute [ V2 x y | (x, y) <- rest ]</span>
|
||||
<span class="lineno"> 337 </span><span class="spaces"> </span><span class="istickedoff">, EndPath ]</span></span>
|
||||
<span class="lineno"> 338 </span>
|
||||
<span class="lineno"> 339 </span>-- | Rectangle with a uniform color and the same size as the screen.
|
||||
<span class="lineno"> 340 </span>--
|
||||
<span class="lineno"> 341 </span>-- Example:
|
||||
<span class="lineno"> 342 </span>--
|
||||
<span class="lineno"> 343 </span>-- > animate $ const $ mkBackground "yellow"
|
||||
<span class="lineno"> 344 </span>--
|
||||
<span class="lineno"> 345 </span>-- <<docs/gifs/doc_mkBackground.gif>>
|
||||
<span class="lineno"> 346 </span>mkBackground :: String -> Tree
|
||||
<span class="lineno"> 347 </span><span class="decl"><span class="istickedoff">mkBackground color = withFillOpacity 1 $ withStrokeWidth 0 $</span>
|
||||
<span class="lineno"> 348 </span><span class="spaces"> </span><span class="istickedoff">withFillColor color $ mkRect screenWidth screenHeight</span></span>
|
||||
<span class="lineno"> 349 </span>
|
||||
<span class="lineno"> 350 </span>mkBackgroundPixel :: PixelRGBA8 -> Tree
|
||||
<span class="lineno"> 351 </span><span class="decl"><span class="istickedoff">mkBackgroundPixel pixel =</span>
|
||||
<span class="lineno"> 352 </span><span class="spaces"> </span><span class="istickedoff">withFillOpacity 1 $ withStrokeWidth 0 $</span>
|
||||
<span class="lineno"> 353 </span><span class="spaces"> </span><span class="istickedoff">withFillColorPixel pixel $ mkRect screenWidth screenHeight</span></span>
|
||||
<span class="lineno"> 354 </span>
|
||||
<span class="lineno"> 355 </span>-- | Take list of rows, where each row consists of number of images and display them in regular
|
||||
<span class="lineno"> 356 </span>-- grid structure.
|
||||
<span class="lineno"> 357 </span>-- All rows will get equal amount of vertical space.
|
||||
<span class="lineno"> 358 </span>-- The images within each row will get equal amount of horizontal space, independent of the other
|
||||
<span class="lineno"> 359 </span>-- rows. Each row can contain different number of cells.
|
||||
<span class="lineno"> 360 </span>gridLayout :: [[Tree]] -> Tree
|
||||
<span class="lineno"> 361 </span><span class="decl"><span class="istickedoff">gridLayout rows = mkGroup</span>
|
||||
<span class="lineno"> 362 </span><span class="spaces"> </span><span class="istickedoff">[ translate (-screenWidth/2+colSep*nCol + colSep*0.5)</span>
|
||||
<span class="lineno"> 363 </span><span class="spaces"> </span><span class="istickedoff">(screenHeight/2-rowSep*nRow - rowSep*0.5)</span>
|
||||
<span class="lineno"> 364 </span><span class="spaces"> </span><span class="istickedoff">elt</span>
|
||||
<span class="lineno"> 365 </span><span class="spaces"> </span><span class="istickedoff">| (nRow, row) <- zip [0..] rows</span>
|
||||
<span class="lineno"> 366 </span><span class="spaces"> </span><span class="istickedoff">, let nCols = length row</span>
|
||||
<span class="lineno"> 367 </span><span class="spaces"> </span><span class="istickedoff">colSep = screenWidth / fromIntegral nCols</span>
|
||||
<span class="lineno"> 368 </span><span class="spaces"> </span><span class="istickedoff">, (nCol, elt) <- zip [0..] row ]</span>
|
||||
<span class="lineno"> 369 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 370 </span><span class="spaces"> </span><span class="istickedoff">rowSep = screenHeight / fromIntegral nRows</span>
|
||||
<span class="lineno"> 371 </span><span class="spaces"> </span><span class="istickedoff">nRows = length rows</span></span>
|
||||
<span class="lineno"> 372 </span>
|
||||
<span class="lineno"> 373 </span>-- | Insert a native text object anchored at the middle.
|
||||
<span class="lineno"> 374 </span>--
|
||||
<span class="lineno"> 375 </span>-- Example:
|
||||
<span class="lineno"> 376 </span>--
|
||||
<span class="lineno"> 377 </span>-- > mkAnimation 2 $ \t -> scale 2 $ withStrokeWidth 0.05 $ mkText (T.take (round $ t*15) "text")
|
||||
<span class="lineno"> 378 </span>--
|
||||
<span class="lineno"> 379 </span>-- <<docs/gifs/doc_mkText.gif>>
|
||||
<span class="lineno"> 380 </span>mkText :: T.Text -> Tree
|
||||
<span class="lineno"> 381 </span><span class="decl"><span class="istickedoff">mkText str =</span>
|
||||
<span class="lineno"> 382 </span><span class="spaces"> </span><span class="istickedoff">flipYAxis</span>
|
||||
<span class="lineno"> 383 </span><span class="spaces"> </span><span class="istickedoff">(TextTree Nothing $ defaultSvg</span>
|
||||
<span class="lineno"> 384 </span><span class="spaces"> </span><span class="istickedoff">& textRoot .~ span_</span>
|
||||
<span class="lineno"> 385 </span><span class="spaces"> </span><span class="istickedoff">& fontSize .~ pure (Num 2))</span>
|
||||
<span class="lineno"> 386 </span><span class="spaces"> </span><span class="istickedoff">& textAnchor .~ pure TextAnchorMiddle</span>
|
||||
<span class="lineno"> 387 </span><span class="spaces"> </span><span class="istickedoff">-- Note: TextAnchorMiddle is placed on the 'flipYAxis' group such that it can easily</span>
|
||||
<span class="lineno"> 388 </span><span class="spaces"> </span><span class="istickedoff">-- be overwritten by the user.</span>
|
||||
<span class="lineno"> 389 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 390 </span><span class="spaces"> </span><span class="istickedoff">span_ = defaultSvg & spanContent .~ [SpanText str]</span></span>
|
||||
<span class="lineno"> 391 </span>
|
||||
<span class="lineno"> 392 </span>-- | Switch from the default viewbox to a custom viewbox. Nesting custom viewboxes is
|
||||
<span class="lineno"> 393 </span>-- unlikely to give good results. If you need nested custom viewboxes, you will have
|
||||
<span class="lineno"> 394 </span>-- to configure them by hand.
|
||||
<span class="lineno"> 395 </span>--
|
||||
<span class="lineno"> 396 </span>-- The viewbox argument is (min-x, min-y, width, height).
|
||||
<span class="lineno"> 397 </span>--
|
||||
<span class="lineno"> 398 </span>-- Example:
|
||||
<span class="lineno"> 399 </span>--
|
||||
<span class="lineno"> 400 </span>-- > withViewBox (0,0,1,1) $ mkBackground "yellow"
|
||||
<span class="lineno"> 401 </span>--
|
||||
<span class="lineno"> 402 </span>-- <<docs/gifs/doc_withViewBox.gif>>
|
||||
<span class="lineno"> 403 </span>withViewBox :: (Double, Double, Double, Double) -> Tree -> Tree
|
||||
<span class="lineno"> 404 </span><span class="decl"><span class="istickedoff">withViewBox vbox child = translate (-screenWidth/2) (-screenHeight/2) $</span>
|
||||
<span class="lineno"> 405 </span><span class="spaces"> </span><span class="istickedoff">SvgTree $ Document</span>
|
||||
<span class="lineno"> 406 </span><span class="spaces"> </span><span class="istickedoff">{ _viewBox = Just vbox</span>
|
||||
<span class="lineno"> 407 </span><span class="spaces"> </span><span class="istickedoff">, _width = Just (Num screenWidth)</span>
|
||||
<span class="lineno"> 408 </span><span class="spaces"> </span><span class="istickedoff">, _height = Just (Num screenHeight)</span>
|
||||
<span class="lineno"> 409 </span><span class="spaces"> </span><span class="istickedoff">, _elements = [child]</span>
|
||||
<span class="lineno"> 410 </span><span class="spaces"> </span><span class="istickedoff">, _description = ""</span>
|
||||
<span class="lineno"> 411 </span><span class="spaces"> </span><span class="istickedoff">, _documentLocation = <span class="nottickedoff">""</span></span>
|
||||
<span class="lineno"> 412 </span><span class="spaces"> </span><span class="istickedoff">, _documentAspectRatio = PreserveAspectRatio False AlignNone Nothing</span>
|
||||
<span class="lineno"> 413 </span><span class="spaces"> </span><span class="istickedoff">}</span></span>
|
||||
<span class="lineno"> 293 </span>-- | Create an element by referring to existing element defined previously.
|
||||
<span class="lineno"> 294 </span>-- For example you can create a graphical element, assign ID to it using 'withId', wrap it in
|
||||
<span class="lineno"> 295 </span>-- 'mkDefinitions' and then use it via @use "myId"@.
|
||||
<span class="lineno"> 296 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/use>
|
||||
<span class="lineno"> 297 </span>mkUse :: String -> Tree
|
||||
<span class="lineno"> 298 </span><span class="decl"><span class="nottickedoff">mkUse name = UseTree (defaultSvg & useName .~ name) Nothing</span></span>
|
||||
<span class="lineno"> 299 </span>
|
||||
<span class="lineno"> 300 </span>-- | A clip path restricts the region to which paint can be applied.
|
||||
<span class="lineno"> 301 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/clipPath>
|
||||
<span class="lineno"> 302 </span>mkClipPath :: String -- ^ ID of the clip path, which can then be referred to by other elements
|
||||
<span class="lineno"> 303 </span> -- using 'withClipPathRef'.
|
||||
<span class="lineno"> 304 </span> -> [Tree] -- ^ List of shapes that will determine the final shape of the clipping region
|
||||
<span class="lineno"> 305 </span> -> Tree
|
||||
<span class="lineno"> 306 </span><span class="decl"><span class="nottickedoff">mkClipPath idTag forest = withId idTag $ ClipPathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 307 </span><span class="spaces"> </span><span class="nottickedoff">& clipPathContent .~ forest</span></span>
|
||||
<span class="lineno"> 308 </span>
|
||||
<span class="lineno"> 309 </span>-- | Create a path from the list of path commands.
|
||||
<span class="lineno"> 310 </span>-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d#Path_commands>
|
||||
<span class="lineno"> 311 </span>mkPath :: [PathCommand] -> Tree
|
||||
<span class="lineno"> 312 </span><span class="decl"><span class="istickedoff">mkPath cmds = PathTree $ defaultSvg & pathDefinition .~ cmds</span></span>
|
||||
<span class="lineno"> 313 </span>
|
||||
<span class="lineno"> 314 </span>-- | Similar to 'mkPathText', but taking SVG path command as a String.
|
||||
<span class="lineno"> 315 </span>mkPathString :: String -> Tree
|
||||
<span class="lineno"> 316 </span><span class="decl"><span class="istickedoff">mkPathString = mkPathText . T.pack</span></span>
|
||||
<span class="lineno"> 317 </span>
|
||||
<span class="lineno"> 318 </span>-- | Create path from textual representation of SVG path command.
|
||||
<span class="lineno"> 319 </span>-- If the text doesn't represent valid path command, this function fails with 'Prelude.error'.
|
||||
<span class="lineno"> 320 </span>-- Use 'mkPath' for type safe way of creating paths.
|
||||
<span class="lineno"> 321 </span>mkPathText :: T.Text -> Tree
|
||||
<span class="lineno"> 322 </span><span class="decl"><span class="istickedoff">mkPathText str =</span>
|
||||
<span class="lineno"> 323 </span><span class="spaces"> </span><span class="istickedoff">case parseOnly pathParser str of</span>
|
||||
<span class="lineno"> 324 </span><span class="spaces"> </span><span class="istickedoff">Left err -> <span class="nottickedoff">error err</span></span>
|
||||
<span class="lineno"> 325 </span><span class="spaces"> </span><span class="istickedoff">Right cmds -> mkPath cmds</span></span>
|
||||
<span class="lineno"> 326 </span>
|
||||
<span class="lineno"> 327 </span>-- | Create a path from a list of @(x, y)@ coordinates of points along the path.
|
||||
<span class="lineno"> 328 </span>mkLinePath :: [(Double, Double)] -> Tree
|
||||
<span class="lineno"> 329 </span><span class="decl"><span class="nottickedoff">mkLinePath [] = mkGroup []</span>
|
||||
<span class="lineno"> 330 </span><span class="spaces"></span><span class="nottickedoff">mkLinePath ((startX, startY):rest) =</span>
|
||||
<span class="lineno"> 331 </span><span class="spaces"> </span><span class="nottickedoff">PathTree $ defaultSvg & pathDefinition .~ cmds</span>
|
||||
<span class="lineno"> 332 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 333 </span><span class="spaces"> </span><span class="nottickedoff">cmds = [ MoveTo OriginAbsolute [V2 startX startY]</span>
|
||||
<span class="lineno"> 334 </span><span class="spaces"> </span><span class="nottickedoff">, LineTo OriginAbsolute [ V2 x y | (x, y) <- rest ] ]</span></span>
|
||||
<span class="lineno"> 335 </span>
|
||||
<span class="lineno"> 336 </span>-- | Create a path from a list of @(x, y)@ coordinates of points along the path.
|
||||
<span class="lineno"> 337 </span>mkLinePathClosed :: [(Double, Double)] -> Tree
|
||||
<span class="lineno"> 338 </span><span class="decl"><span class="istickedoff">mkLinePathClosed [] = <span class="nottickedoff">mkGroup []</span></span>
|
||||
<span class="lineno"> 339 </span><span class="spaces"></span><span class="istickedoff">mkLinePathClosed ((startX, startY):rest) =</span>
|
||||
<span class="lineno"> 340 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg & pathDefinition .~ cmds</span>
|
||||
<span class="lineno"> 341 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 342 </span><span class="spaces"> </span><span class="istickedoff">cmds = [ MoveTo OriginAbsolute [V2 startX startY]</span>
|
||||
<span class="lineno"> 343 </span><span class="spaces"> </span><span class="istickedoff">, LineTo OriginAbsolute [ V2 x y | (x, y) <- rest ]</span>
|
||||
<span class="lineno"> 344 </span><span class="spaces"> </span><span class="istickedoff">, EndPath ]</span></span>
|
||||
<span class="lineno"> 345 </span>
|
||||
<span class="lineno"> 346 </span>-- | Rectangle with a uniform color and the same size as the screen.
|
||||
<span class="lineno"> 347 </span>--
|
||||
<span class="lineno"> 348 </span>-- Example:
|
||||
<span class="lineno"> 349 </span>--
|
||||
<span class="lineno"> 350 </span>-- > animate $ const $ mkBackground "yellow"
|
||||
<span class="lineno"> 351 </span>--
|
||||
<span class="lineno"> 352 </span>-- <<docs/gifs/doc_mkBackground.gif>>
|
||||
<span class="lineno"> 353 </span>mkBackground :: String -> Tree
|
||||
<span class="lineno"> 354 </span><span class="decl"><span class="istickedoff">mkBackground color = withFillOpacity 1 $ withStrokeWidth 0 $</span>
|
||||
<span class="lineno"> 355 </span><span class="spaces"> </span><span class="istickedoff">withFillColor color $ mkRect screenWidth screenHeight</span></span>
|
||||
<span class="lineno"> 356 </span>
|
||||
<span class="lineno"> 357 </span>-- | Rectangle with a uniform color and the same size as the screen.
|
||||
<span class="lineno"> 358 </span>mkBackgroundPixel :: PixelRGBA8 -> Tree
|
||||
<span class="lineno"> 359 </span><span class="decl"><span class="istickedoff">mkBackgroundPixel pixel =</span>
|
||||
<span class="lineno"> 360 </span><span class="spaces"> </span><span class="istickedoff">withFillOpacity 1 $ withStrokeWidth 0 $</span>
|
||||
<span class="lineno"> 361 </span><span class="spaces"> </span><span class="istickedoff">withFillColorPixel pixel $ mkRect screenWidth screenHeight</span></span>
|
||||
<span class="lineno"> 362 </span>
|
||||
<span class="lineno"> 363 </span>-- | Take list of rows, where each row consists of number of images and display them in regular
|
||||
<span class="lineno"> 364 </span>-- grid structure.
|
||||
<span class="lineno"> 365 </span>-- All rows will get equal amount of vertical space.
|
||||
<span class="lineno"> 366 </span>-- The images within each row will get equal amount of horizontal space, independent of the other
|
||||
<span class="lineno"> 367 </span>-- rows. Each row can contain different number of cells.
|
||||
<span class="lineno"> 368 </span>gridLayout :: [[Tree]] -> Tree
|
||||
<span class="lineno"> 369 </span><span class="decl"><span class="istickedoff">gridLayout rows = mkGroup</span>
|
||||
<span class="lineno"> 370 </span><span class="spaces"> </span><span class="istickedoff">[ translate (-screenWidth/2+colSep*nCol + colSep*0.5)</span>
|
||||
<span class="lineno"> 371 </span><span class="spaces"> </span><span class="istickedoff">(screenHeight/2-rowSep*nRow - rowSep*0.5)</span>
|
||||
<span class="lineno"> 372 </span><span class="spaces"> </span><span class="istickedoff">elt</span>
|
||||
<span class="lineno"> 373 </span><span class="spaces"> </span><span class="istickedoff">| (nRow, row) <- zip [0..] rows</span>
|
||||
<span class="lineno"> 374 </span><span class="spaces"> </span><span class="istickedoff">, let nCols = length row</span>
|
||||
<span class="lineno"> 375 </span><span class="spaces"> </span><span class="istickedoff">colSep = screenWidth / fromIntegral nCols</span>
|
||||
<span class="lineno"> 376 </span><span class="spaces"> </span><span class="istickedoff">, (nCol, elt) <- zip [0..] row ]</span>
|
||||
<span class="lineno"> 377 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 378 </span><span class="spaces"> </span><span class="istickedoff">rowSep = screenHeight / fromIntegral nRows</span>
|
||||
<span class="lineno"> 379 </span><span class="spaces"> </span><span class="istickedoff">nRows = length rows</span></span>
|
||||
<span class="lineno"> 380 </span>
|
||||
<span class="lineno"> 381 </span>-- | Insert a native text object anchored at the middle.
|
||||
<span class="lineno"> 382 </span>--
|
||||
<span class="lineno"> 383 </span>-- Example:
|
||||
<span class="lineno"> 384 </span>--
|
||||
<span class="lineno"> 385 </span>-- > mkAnimation 2 $ \t -> scale 2 $ withStrokeWidth 0.05 $ mkText (T.take (round $ t*15) "text")
|
||||
<span class="lineno"> 386 </span>--
|
||||
<span class="lineno"> 387 </span>-- <<docs/gifs/doc_mkText.gif>>
|
||||
<span class="lineno"> 388 </span>mkText :: T.Text -> Tree
|
||||
<span class="lineno"> 389 </span><span class="decl"><span class="istickedoff">mkText str =</span>
|
||||
<span class="lineno"> 390 </span><span class="spaces"> </span><span class="istickedoff">flipYAxis</span>
|
||||
<span class="lineno"> 391 </span><span class="spaces"> </span><span class="istickedoff">(TextTree Nothing $ defaultSvg</span>
|
||||
<span class="lineno"> 392 </span><span class="spaces"> </span><span class="istickedoff">& textRoot .~ span_</span>
|
||||
<span class="lineno"> 393 </span><span class="spaces"> </span><span class="istickedoff">& fontSize .~ pure (Num 2))</span>
|
||||
<span class="lineno"> 394 </span><span class="spaces"> </span><span class="istickedoff">& textAnchor .~ pure TextAnchorMiddle</span>
|
||||
<span class="lineno"> 395 </span><span class="spaces"> </span><span class="istickedoff">-- Note: TextAnchorMiddle is placed on the 'flipYAxis' group such that it can easily</span>
|
||||
<span class="lineno"> 396 </span><span class="spaces"> </span><span class="istickedoff">-- be overwritten by the user.</span>
|
||||
<span class="lineno"> 397 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 398 </span><span class="spaces"> </span><span class="istickedoff">span_ = defaultSvg & spanContent .~ [SpanText str]</span></span>
|
||||
<span class="lineno"> 399 </span>
|
||||
<span class="lineno"> 400 </span>-- | Switch from the default viewbox to a custom viewbox. Nesting custom viewboxes is
|
||||
<span class="lineno"> 401 </span>-- unlikely to give good results. If you need nested custom viewboxes, you will have
|
||||
<span class="lineno"> 402 </span>-- to configure them by hand.
|
||||
<span class="lineno"> 403 </span>--
|
||||
<span class="lineno"> 404 </span>-- The viewbox argument is (min-x, min-y, width, height).
|
||||
<span class="lineno"> 405 </span>--
|
||||
<span class="lineno"> 406 </span>-- Example:
|
||||
<span class="lineno"> 407 </span>--
|
||||
<span class="lineno"> 408 </span>-- > withViewBox (0,0,1,1) $ mkBackground "yellow"
|
||||
<span class="lineno"> 409 </span>--
|
||||
<span class="lineno"> 410 </span>-- <<docs/gifs/doc_withViewBox.gif>>
|
||||
<span class="lineno"> 411 </span>withViewBox :: (Double, Double, Double, Double) -> Tree -> Tree
|
||||
<span class="lineno"> 412 </span><span class="decl"><span class="istickedoff">withViewBox vbox child = translate (-screenWidth/2) (-screenHeight/2) $</span>
|
||||
<span class="lineno"> 413 </span><span class="spaces"> </span><span class="istickedoff">SvgTree $ Document</span>
|
||||
<span class="lineno"> 414 </span><span class="spaces"> </span><span class="istickedoff">{ _viewBox = Just vbox</span>
|
||||
<span class="lineno"> 415 </span><span class="spaces"> </span><span class="istickedoff">, _width = Just (Num screenWidth)</span>
|
||||
<span class="lineno"> 416 </span><span class="spaces"> </span><span class="istickedoff">, _height = Just (Num screenHeight)</span>
|
||||
<span class="lineno"> 417 </span><span class="spaces"> </span><span class="istickedoff">, _elements = [child]</span>
|
||||
<span class="lineno"> 418 </span><span class="spaces"> </span><span class="istickedoff">, _description = ""</span>
|
||||
<span class="lineno"> 419 </span><span class="spaces"> </span><span class="istickedoff">, _documentLocation = <span class="nottickedoff">""</span></span>
|
||||
<span class="lineno"> 420 </span><span class="spaces"> </span><span class="istickedoff">, _documentAspectRatio = PreserveAspectRatio False AlignNone Nothing</span>
|
||||
<span class="lineno"> 421 </span><span class="spaces"> </span><span class="istickedoff">}</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
|
|
|
|||
|
|
@ -30,53 +30,56 @@ span.spaces { background: white }
|
|||
<span class="lineno"> 11 </span>import Reanimate.Constants
|
||||
<span class="lineno"> 12 </span>import Reanimate.Svg.Constructors
|
||||
<span class="lineno"> 13 </span>
|
||||
<span class="lineno"> 14 </span>replaceUses :: Document -> Document
|
||||
<span class="lineno"> 15 </span><span class="decl"><span class="nottickedoff">replaceUses doc = doc & elements %~ map (mapTree replace)</span>
|
||||
<span class="lineno"> 16 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 17 </span><span class="spaces"> </span><span class="nottickedoff">replaceDefinition PathTree{} = None</span>
|
||||
<span class="lineno"> 18 </span><span class="spaces"> </span><span class="nottickedoff">replaceDefinition t = t</span>
|
||||
<span class="lineno"> 19 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 20 </span><span class="spaces"> </span><span class="nottickedoff">replace t@DefinitionTree{} = mapTree replaceDefinition t</span>
|
||||
<span class="lineno"> 21 </span><span class="spaces"> </span><span class="nottickedoff">replace (UseTree _ Just{}) = error "replaceUses: subtree in use?"</span>
|
||||
<span class="lineno"> 22 </span><span class="spaces"> </span><span class="nottickedoff">replace (UseTree use Nothing) =</span>
|
||||
<span class="lineno"> 23 </span><span class="spaces"> </span><span class="nottickedoff">case Map.lookup (use^.useName) idMap of</span>
|
||||
<span class="lineno"> 24 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> error $ "Unknown id: " ++ (use^.useName)</span>
|
||||
<span class="lineno"> 25 </span><span class="spaces"> </span><span class="nottickedoff">Just tree -> mapTree replace $</span>
|
||||
<span class="lineno"> 26 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree $</span>
|
||||
<span class="lineno"> 27 </span><span class="spaces"> </span><span class="nottickedoff">defaultSvg & groupChildren .~ [tree]</span>
|
||||
<span class="lineno"> 28 </span><span class="spaces"> </span><span class="nottickedoff">& transform ?~</span>
|
||||
<span class="lineno"> 29 </span><span class="spaces"> </span><span class="nottickedoff">fromMaybe [] (use^.transform) ++</span>
|
||||
<span class="lineno"> 30 </span><span class="spaces"> </span><span class="nottickedoff">[baseToTransformation (use^.useBase)]</span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="nottickedoff">replace x = x</span>
|
||||
<span class="lineno"> 32 </span><span class="spaces"> </span><span class="nottickedoff">baseToTransformation (x,y) =</span>
|
||||
<span class="lineno"> 33 </span><span class="spaces"> </span><span class="nottickedoff">case (toUserUnit defaultDPI x, toUserUnit defaultDPI y) of</span>
|
||||
<span class="lineno"> 34 </span><span class="spaces"> </span><span class="nottickedoff">(Num a, Num b) -> Translate a b</span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"> </span><span class="nottickedoff">_ -> TransformUnknown</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="nottickedoff">docTree = mkGroup (doc^.elements)</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="nottickedoff">idMap = foldTree updMap Map.empty docTree</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="nottickedoff">updMap m tree =</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="nottickedoff">case tree^.attrId of</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> m</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="nottickedoff">Just tid -> Map.insert tid tree m</span></span>
|
||||
<span class="lineno"> 42 </span>
|
||||
<span class="lineno"> 43 </span>-- FIXME: the viewbox is ignored. Can we use the viewbox as a mask?
|
||||
<span class="lineno"> 44 </span>-- Transform out viewbox. defs and CSS rules are discarded.
|
||||
<span class="lineno"> 45 </span>unbox :: Document -> Tree
|
||||
<span class="lineno"> 46 </span><span class="decl"><span class="nottickedoff">unbox doc@Document{_viewBox = Just (_minx, _minw, _width, _height)} =</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree $ defaultSvg</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="nottickedoff">& groupChildren .~ doc^.elements</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"></span><span class="nottickedoff">unbox doc =</span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree $ defaultSvg</span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="nottickedoff">& groupChildren .~ doc^.elements</span></span>
|
||||
<span class="lineno"> 52 </span>
|
||||
<span class="lineno"> 53 </span>embedDocument :: Document -> Tree
|
||||
<span class="lineno"> 54 </span><span class="decl"><span class="istickedoff">embedDocument doc =</span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="istickedoff">translate (-screenWidth/2) (screenHeight/2) $</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="istickedoff">withFillOpacity 1 $</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="istickedoff">withStrokeWidth 0 $</span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="istickedoff">flipYAxis $</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="istickedoff">SvgTree $ doc & width .~ Nothing</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="istickedoff">& height .~ Nothing</span></span>
|
||||
<span class="lineno"> 14 </span>-- | Replace all @<use>@ nodes with their definition.
|
||||
<span class="lineno"> 15 </span>replaceUses :: Document -> Document
|
||||
<span class="lineno"> 16 </span><span class="decl"><span class="nottickedoff">replaceUses doc = doc & elements %~ map (mapTree replace)</span>
|
||||
<span class="lineno"> 17 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 18 </span><span class="spaces"> </span><span class="nottickedoff">replaceDefinition PathTree{} = None</span>
|
||||
<span class="lineno"> 19 </span><span class="spaces"> </span><span class="nottickedoff">replaceDefinition t = t</span>
|
||||
<span class="lineno"> 20 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 21 </span><span class="spaces"> </span><span class="nottickedoff">replace t@DefinitionTree{} = mapTree replaceDefinition t</span>
|
||||
<span class="lineno"> 22 </span><span class="spaces"> </span><span class="nottickedoff">replace (UseTree _ Just{}) = error "replaceUses: subtree in use?"</span>
|
||||
<span class="lineno"> 23 </span><span class="spaces"> </span><span class="nottickedoff">replace (UseTree use Nothing) =</span>
|
||||
<span class="lineno"> 24 </span><span class="spaces"> </span><span class="nottickedoff">case Map.lookup (use^.useName) idMap of</span>
|
||||
<span class="lineno"> 25 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> error $ "Unknown id: " ++ (use^.useName)</span>
|
||||
<span class="lineno"> 26 </span><span class="spaces"> </span><span class="nottickedoff">Just tree -> mapTree replace $</span>
|
||||
<span class="lineno"> 27 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree $</span>
|
||||
<span class="lineno"> 28 </span><span class="spaces"> </span><span class="nottickedoff">defaultSvg & groupChildren .~ [tree]</span>
|
||||
<span class="lineno"> 29 </span><span class="spaces"> </span><span class="nottickedoff">& transform ?~</span>
|
||||
<span class="lineno"> 30 </span><span class="spaces"> </span><span class="nottickedoff">fromMaybe [] (use^.transform) ++</span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="nottickedoff">[baseToTransformation (use^.useBase)]</span>
|
||||
<span class="lineno"> 32 </span><span class="spaces"> </span><span class="nottickedoff">replace x = x</span>
|
||||
<span class="lineno"> 33 </span><span class="spaces"> </span><span class="nottickedoff">baseToTransformation (x,y) =</span>
|
||||
<span class="lineno"> 34 </span><span class="spaces"> </span><span class="nottickedoff">case (toUserUnit defaultDPI x, toUserUnit defaultDPI y) of</span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"> </span><span class="nottickedoff">(Num a, Num b) -> Translate a b</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="nottickedoff">_ -> TransformUnknown</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="nottickedoff">docTree = mkGroup (doc^.elements)</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="nottickedoff">idMap = foldTree updMap Map.empty docTree</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="nottickedoff">updMap m tree =</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="nottickedoff">case tree^.attrId of</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> m</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="nottickedoff">Just tid -> Map.insert tid tree m</span></span>
|
||||
<span class="lineno"> 43 </span>
|
||||
<span class="lineno"> 44 </span>-- FIXME: the viewbox is ignored. Can we use the viewbox as a mask?
|
||||
<span class="lineno"> 45 </span>-- | Transform out viewbox. Definitions and CSS rules are discarded.
|
||||
<span class="lineno"> 46 </span>unbox :: Document -> Tree
|
||||
<span class="lineno"> 47 </span><span class="decl"><span class="nottickedoff">unbox doc@Document{_viewBox = Just (_minx, _minw, _width, _height)} =</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree $ defaultSvg</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="nottickedoff">& groupChildren .~ doc^.elements</span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"></span><span class="nottickedoff">unbox doc =</span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree $ defaultSvg</span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="nottickedoff">& groupChildren .~ doc^.elements</span></span>
|
||||
<span class="lineno"> 53 </span>
|
||||
<span class="lineno"> 54 </span>-- | Embed 'Document'. This keeps the entire document intact but makes
|
||||
<span class="lineno"> 55 </span>-- it more difficult to use, say, `Reanimate.Svg.pathify` on it.
|
||||
<span class="lineno"> 56 </span>embedDocument :: Document -> Tree
|
||||
<span class="lineno"> 57 </span><span class="decl"><span class="istickedoff">embedDocument doc =</span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="istickedoff">translate (-screenWidth/2) (screenHeight/2) $</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="istickedoff">withFillOpacity 1 $</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="istickedoff">withStrokeWidth 0 $</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="istickedoff">flipYAxis $</span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="istickedoff">SvgTree $ doc & width .~ Nothing</span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="istickedoff">& height .~ Nothing</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
|
|
|
|||
|
|
@ -39,297 +39,312 @@ span.spaces { background: white }
|
|||
<span class="lineno"> 20 </span>import Reanimate.Svg.Unuse
|
||||
<span class="lineno"> 21 </span>import qualified Reanimate.Transform as Transform
|
||||
<span class="lineno"> 22 </span>
|
||||
<span class="lineno"> 23 </span>lowerTransformations :: Tree -> Tree
|
||||
<span class="lineno"> 24 </span><span class="decl"><span class="istickedoff">lowerTransformations = worker <span class="nottickedoff">False</span> Transform.identity</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">updLineCmd m cmd =</span>
|
||||
<span class="lineno"> 27 </span><span class="spaces"> </span><span class="istickedoff">case cmd of</span>
|
||||
<span class="lineno"> 28 </span><span class="spaces"> </span><span class="istickedoff">LineMove p -> LineMove $ Transform.transformPoint m p</span>
|
||||
<span class="lineno"> 29 </span><span class="spaces"> </span><span class="istickedoff">-- LineDraw p -> LineDraw $ Transform.transformPoint m p</span>
|
||||
<span class="lineno"> 30 </span><span class="spaces"> </span><span class="istickedoff">LineBezier ps -> LineBezier $ map (Transform.transformPoint m) ps</span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="istickedoff">LineEnd p -> LineEnd $ <span class="nottickedoff">Transform.transformPoint m p</span></span>
|
||||
<span class="lineno"> 32 </span><span class="spaces"> </span><span class="istickedoff">updPath m = lineToPath . map (updLineCmd m) . toLineCommands</span>
|
||||
<span class="lineno"> 33 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">updPoint m (Num a,Num b) =</span></span>
|
||||
<span class="lineno"> 34 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case Transform.transformPoint m (V2 a b) of</span></span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">V2 x y -> (Num x, Num y)</span></span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">updPoint _ other = other</span> -- XXX: Can we do better here?</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="istickedoff">worker hasPathified m t =</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="istickedoff">let m' = m * Transform.mkMatrix (t^.transform) in</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="istickedoff">case t of</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="istickedoff">PathTree path -> PathTree $</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="istickedoff">path & pathDefinition %~ updPath m'</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="istickedoff">& transform .~ Nothing</span>
|
||||
<span class="lineno"> 43 </span><span class="spaces"> </span><span class="istickedoff">GroupTree g -> <span class="nottickedoff">GroupTree $</span></span>
|
||||
<span class="lineno"> 44 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">g & groupChildren %~ map (worker hasPathified m')</span></span>
|
||||
<span class="lineno"> 45 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& transform .~ Nothing</span></span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="istickedoff">LineTree line -></span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">LineTree $</span></span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">line & linePoint1 %~ updPoint m</span></span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& linePoint2 %~ updPoint m</span></span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="istickedoff">ClipPathTree{} -> <span class="nottickedoff">t</span></span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="istickedoff">-- If we encounter an unknown node and we've already tried to convert</span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="istickedoff">-- to paths, give up and insert an explicit transformation.</span>
|
||||
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="istickedoff">_ | <span class="nottickedoff">hasPathified</span> -></span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">mkGroup [t] & transform ?~ [ Transform.toTransformation m ]</span></span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="istickedoff">-- If we haven't tried to pathify, run pathify only once.</span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">worker True m (pathify t)</span></span></span>
|
||||
<span class="lineno"> 57 </span>
|
||||
<span class="lineno"> 58 </span>lowerIds :: Tree -> Tree
|
||||
<span class="lineno"> 59 </span><span class="decl"><span class="nottickedoff">lowerIds = mapTree worker</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="nottickedoff">worker t@GroupTree{} = t & attrId .~ Nothing</span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="nottickedoff">worker t@PathTree{} = t & attrId .~ Nothing</span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="nottickedoff">worker t = t</span></span>
|
||||
<span class="lineno"> 23 </span>-- | Remove transformations (such as translations, rotations, scaling)
|
||||
<span class="lineno"> 24 </span>-- and apply them directly to the SVG nodes. Note, this function
|
||||
<span class="lineno"> 25 </span>-- may convert nodes (such as Circle or Rect) to paths. Also note
|
||||
<span class="lineno"> 26 </span>-- that /does/ change how the SVG is rendered. Particularly, stroke
|
||||
<span class="lineno"> 27 </span>-- width is affected by directly applying scaling.
|
||||
<span class="lineno"> 28 </span>--
|
||||
<span class="lineno"> 29 </span>-- @lowerTransformations (scale 2 (mkCircle 1)) = mkCircle 2@
|
||||
<span class="lineno"> 30 </span>lowerTransformations :: Tree -> Tree
|
||||
<span class="lineno"> 31 </span><span class="decl"><span class="istickedoff">lowerTransformations = worker <span class="nottickedoff">False</span> Transform.identity</span>
|
||||
<span class="lineno"> 32 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 33 </span><span class="spaces"> </span><span class="istickedoff">updLineCmd m cmd =</span>
|
||||
<span class="lineno"> 34 </span><span class="spaces"> </span><span class="istickedoff">case cmd of</span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"> </span><span class="istickedoff">LineMove p -> LineMove $ Transform.transformPoint m p</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="istickedoff">-- LineDraw p -> LineDraw $ Transform.transformPoint m p</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="istickedoff">LineBezier ps -> LineBezier $ map (Transform.transformPoint m) ps</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="istickedoff">LineEnd p -> LineEnd $ <span class="nottickedoff">Transform.transformPoint m p</span></span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="istickedoff">updPath m = lineToPath . map (updLineCmd m) . toLineCommands</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">updPoint m (Num a,Num b) =</span></span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">case Transform.transformPoint m (V2 a b) of</span></span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">V2 x y -> (Num x, Num y)</span></span>
|
||||
<span class="lineno"> 43 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">updPoint _ other = other</span> -- XXX: Can we do better here?</span>
|
||||
<span class="lineno"> 44 </span><span class="spaces"> </span><span class="istickedoff">worker hasPathified m t =</span>
|
||||
<span class="lineno"> 45 </span><span class="spaces"> </span><span class="istickedoff">let m' = m * Transform.mkMatrix (t^.transform) in</span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="istickedoff">case t of</span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="istickedoff">PathTree path -> PathTree $</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="istickedoff">path & pathDefinition %~ updPath m'</span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="istickedoff">& transform .~ Nothing</span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="istickedoff">GroupTree g -> <span class="nottickedoff">GroupTree $</span></span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">g & groupChildren %~ map (worker hasPathified m')</span></span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& transform .~ Nothing</span></span>
|
||||
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="istickedoff">LineTree line -></span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">LineTree $</span></span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">line & linePoint1 %~ updPoint m</span></span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& linePoint2 %~ updPoint m</span></span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="istickedoff">ClipPathTree{} -> <span class="nottickedoff">t</span></span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="istickedoff">-- If we encounter an unknown node and we've already tried to convert</span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="istickedoff">-- to paths, give up and insert an explicit transformation.</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="istickedoff">_ | <span class="nottickedoff">hasPathified</span> -></span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">mkGroup [t] & transform ?~ [ Transform.toTransformation m ]</span></span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="istickedoff">-- If we haven't tried to pathify, run pathify only once.</span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">worker True m (pathify t)</span></span></span>
|
||||
<span class="lineno"> 64 </span>
|
||||
<span class="lineno"> 65 </span>simplify :: Tree -> Tree
|
||||
<span class="lineno"> 66 </span><span class="decl"><span class="istickedoff">simplify root =</span>
|
||||
<span class="lineno"> 67 </span><span class="spaces"> </span><span class="istickedoff">case worker root of</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="istickedoff">[] -> <span class="nottickedoff">None</span></span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="istickedoff">[x] -> x</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="istickedoff">xs -> <span class="nottickedoff">mkGroup xs</span></span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 72 </span><span class="spaces"> </span><span class="istickedoff">worker None = <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 73 </span><span class="spaces"> </span><span class="istickedoff">worker (DefinitionTree d) =</span>
|
||||
<span class="lineno"> 74 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">concatMap dropNulls</span></span>
|
||||
<span class="lineno"> 75 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[DefinitionTree $ d & groupChildren %~ concatMap worker]</span></span>
|
||||
<span class="lineno"> 76 </span><span class="spaces"> </span><span class="istickedoff">worker (GroupTree g)</span>
|
||||
<span class="lineno"> 77 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">g ^. drawAttributes == defaultSvg</span> =</span>
|
||||
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">concatMap dropNulls $</span></span>
|
||||
<span class="lineno"> 79 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">concatMap worker (g^.groupChildren)</span></span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span> =</span>
|
||||
<span class="lineno"> 81 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">dropNulls $</span></span>
|
||||
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">GroupTree $ g & groupChildren %~ concatMap worker</span></span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="istickedoff">worker t = dropNulls t</span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="istickedoff">dropNulls None = <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="istickedoff">dropNulls (DefinitionTree d)</span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">null (d^.groupChildren)</span> = <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="istickedoff">dropNulls (GroupTree g)</span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">null (g^.groupChildren)</span> = <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="istickedoff">dropNulls t = [t]</span></span>
|
||||
<span class="lineno"> 91 </span>
|
||||
<span class="lineno"> 92 </span>removeGroups :: Tree -> [Tree]
|
||||
<span class="lineno"> 93 </span><span class="decl"><span class="nottickedoff">removeGroups = worker defaultSvg</span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="nottickedoff">worker _attr None = []</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="nottickedoff">worker _attr (DefinitionTree d) =</span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="nottickedoff">concatMap dropNulls</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="nottickedoff">[DefinitionTree $ d & groupChildren %~ concatMap (worker defaultSvg)]</span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="nottickedoff">worker attr (GroupTree g)</span>
|
||||
<span class="lineno"> 100 </span><span class="spaces"> </span><span class="nottickedoff">| g ^. drawAttributes == defaultSvg =</span>
|
||||
<span class="lineno"> 101 </span><span class="spaces"> </span><span class="nottickedoff">concatMap dropNulls $</span>
|
||||
<span class="lineno"> 102 </span><span class="spaces"> </span><span class="nottickedoff">concatMap (worker attr) (g^.groupChildren)</span>
|
||||
<span class="lineno"> 103 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise =</span>
|
||||
<span class="lineno"> 104 </span><span class="spaces"> </span><span class="nottickedoff">concatMap (worker (attr <> g ^. drawAttributes)) (g^.groupChildren)</span>
|
||||
<span class="lineno"> 105 </span><span class="spaces"> </span><span class="nottickedoff">worker attr t = dropNulls (t & drawAttributes .~ attr)</span>
|
||||
<span class="lineno"> 106 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 107 </span><span class="spaces"> </span><span class="nottickedoff">dropNulls None = []</span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="nottickedoff">dropNulls (DefinitionTree d)</span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="nottickedoff">| null (d^.groupChildren) = []</span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="nottickedoff">dropNulls (GroupTree g)</span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="nottickedoff">| null (g^.groupChildren) = []</span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="nottickedoff">dropNulls t = [t]</span></span>
|
||||
<span class="lineno"> 113 </span>
|
||||
<span class="lineno"> 114 </span>extractPath :: Tree -> [PathCommand]
|
||||
<span class="lineno"> 115 </span><span class="decl"><span class="istickedoff">extractPath = worker . simplify . lowerTransformations . pathify</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff">worker (GroupTree g) = <span class="nottickedoff">concatMap worker (g^.groupChildren)</span></span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="istickedoff">worker (PathTree p) = p^.pathDefinition</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="istickedoff">worker _ = <span class="nottickedoff">[]</span></span></span>
|
||||
<span class="lineno"> 120 </span>
|
||||
<span class="lineno"> 121 </span>withSubglyphs :: [Int] -> (Tree -> Tree) -> Tree -> Tree
|
||||
<span class="lineno"> 122 </span><span class="decl"><span class="nottickedoff">withSubglyphs target fn = \t -> evalState (worker t) 0</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="nottickedoff">worker :: Tree -> State Int Tree</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="nottickedoff">worker t =</span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="nottickedoff">case t of</span>
|
||||
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree g -> do</span>
|
||||
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="nottickedoff">cs <- mapM worker (g ^. groupChildren)</span>
|
||||
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="nottickedoff">return $ GroupTree $ g & groupChildren .~ cs</span>
|
||||
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="nottickedoff">PathTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="nottickedoff">CircleTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="nottickedoff">PolyLineTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="nottickedoff">PolygonTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="nottickedoff">EllipseTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="nottickedoff">LineTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="nottickedoff">RectangleTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="nottickedoff">_ -> return t</span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="nottickedoff">handleGlyph :: Tree -> State Int Tree</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="nottickedoff">handleGlyph svg = do</span>
|
||||
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="nottickedoff">n <- get <* modify (+1)</span>
|
||||
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="nottickedoff">if n `elem` target</span>
|
||||
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="nottickedoff">then return $ fn svg</span>
|
||||
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="nottickedoff">else return svg</span></span>
|
||||
<span class="lineno"> 144 </span>
|
||||
<span class="lineno"> 145 </span>splitGlyphs :: [Int] -> Tree -> (Tree, Tree)
|
||||
<span class="lineno"> 146 </span><span class="decl"><span class="nottickedoff">splitGlyphs target = \t -></span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="nottickedoff">let (_, l, r) = execState (worker id t) (0, [], [])</span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="nottickedoff">in (mkGroup l, mkGroup r)</span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="nottickedoff">handleGlyph :: Tree -> State (Int, [Tree], [Tree]) ()</span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="nottickedoff">handleGlyph t = do</span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="nottickedoff">(n, l, r) <- get</span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="nottickedoff">if n `elem` target</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="nottickedoff">then put (n+1, l, t:r)</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="nottickedoff">else put (n+1, t:l, r)</span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="nottickedoff">worker :: (Tree -> Tree) -> Tree -> State (Int, [Tree], [Tree]) ()</span>
|
||||
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="nottickedoff">worker acc t =</span>
|
||||
<span class="lineno"> 158 </span><span class="spaces"> </span><span class="nottickedoff">case t of</span>
|
||||
<span class="lineno"> 159 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree g -> do</span>
|
||||
<span class="lineno"> 160 </span><span class="spaces"> </span><span class="nottickedoff">let acc' sub = acc (GroupTree $ g & groupChildren .~ [sub])</span>
|
||||
<span class="lineno"> 161 </span><span class="spaces"> </span><span class="nottickedoff">mapM_ (worker acc') (g ^. groupChildren)</span>
|
||||
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="nottickedoff">PathTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="nottickedoff">CircleTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="nottickedoff">PolyLineTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="nottickedoff">PolygonTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 166 </span><span class="spaces"> </span><span class="nottickedoff">EllipseTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="nottickedoff">LineTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 168 </span><span class="spaces"> </span><span class="nottickedoff">RectangleTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 169 </span><span class="spaces"> </span><span class="nottickedoff">DefinitionTree{} -> return ()</span>
|
||||
<span class="lineno"> 170 </span><span class="spaces"> </span><span class="nottickedoff">_ -></span>
|
||||
<span class="lineno"> 171 </span><span class="spaces"> </span><span class="nottickedoff">modify $ \(n, l, r) -> (n, acc t:l, r)</span></span>
|
||||
<span class="lineno"> 172 </span>{-
|
||||
<span class="lineno"> 173 </span><g transform="translate(10,10)">
|
||||
<span class="lineno"> 174 </span> <g transform="scale(2)">
|
||||
<span class="lineno"> 175 </span> <circle/>
|
||||
<span class="lineno"> 176 </span> </g>
|
||||
<span class="lineno"> 177 </span> <g transform="scale(0.5)">
|
||||
<span class="lineno"> 178 </span> <rect/>
|
||||
<span class="lineno"> 179 </span> </g>
|
||||
<span class="lineno"> 180 </span></g>
|
||||
<span class="lineno"> 181 </span>
|
||||
<span class="lineno"> 182 </span>[ (\svg -> <g transform="translate(10,10)"><g transform="scale(2)">svg</g></g>, <circle/>)
|
||||
<span class="lineno"> 183 </span>, (\svg -> <g transform="translate(10,10)"><g transform="scale(0.5)">svg</g></g>, <rect/>)]
|
||||
<span class="lineno"> 184 </span>-}
|
||||
<span class="lineno"> 185 </span>svgGlyphs :: Tree -> [(Tree -> Tree, DrawAttributes, Tree)]
|
||||
<span class="lineno"> 186 </span><span class="decl"><span class="istickedoff">svgGlyphs = worker <span class="nottickedoff">id</span> defaultSvg</span>
|
||||
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="istickedoff">worker acc attr =</span>
|
||||
<span class="lineno"> 189 </span><span class="spaces"> </span><span class="istickedoff">\case</span>
|
||||
<span class="lineno"> 190 </span><span class="spaces"> </span><span class="istickedoff">None -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 191 </span><span class="spaces"> </span><span class="istickedoff">GroupTree g -></span>
|
||||
<span class="lineno"> 192 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let acc' sub = acc (GroupTree $ g & groupChildren .~ [sub])</span></span>
|
||||
<span class="lineno"> 193 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">attr' = (g^.drawAttributes) `mappend` attr</span></span>
|
||||
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in concatMap (worker acc' attr') (g ^. groupChildren)</span></span>
|
||||
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="istickedoff">t -> [(<span class="nottickedoff">acc</span>, (t^.drawAttributes) `mappend` attr, t)]</span></span>
|
||||
<span class="lineno"> 65 </span>-- | Remove all @id@ attributes.
|
||||
<span class="lineno"> 66 </span>lowerIds :: Tree -> Tree
|
||||
<span class="lineno"> 67 </span><span class="decl"><span class="nottickedoff">lowerIds = mapTree worker</span>
|
||||
<span class="lineno"> 68 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 69 </span><span class="spaces"> </span><span class="nottickedoff">worker t@GroupTree{} = t & attrId .~ Nothing</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="nottickedoff">worker t@PathTree{} = t & attrId .~ Nothing</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="nottickedoff">worker t = t</span></span>
|
||||
<span class="lineno"> 72 </span>
|
||||
<span class="lineno"> 73 </span>-- | Optimize SVG tree without affecting how it is rendered.
|
||||
<span class="lineno"> 74 </span>simplify :: Tree -> Tree
|
||||
<span class="lineno"> 75 </span><span class="decl"><span class="istickedoff">simplify root =</span>
|
||||
<span class="lineno"> 76 </span><span class="spaces"> </span><span class="istickedoff">case worker root of</span>
|
||||
<span class="lineno"> 77 </span><span class="spaces"> </span><span class="istickedoff">[] -> <span class="nottickedoff">None</span></span>
|
||||
<span class="lineno"> 78 </span><span class="spaces"> </span><span class="istickedoff">[x] -> x</span>
|
||||
<span class="lineno"> 79 </span><span class="spaces"> </span><span class="istickedoff">xs -> <span class="nottickedoff">mkGroup xs</span></span>
|
||||
<span class="lineno"> 80 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 81 </span><span class="spaces"> </span><span class="istickedoff">worker None = <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 82 </span><span class="spaces"> </span><span class="istickedoff">worker (DefinitionTree d) =</span>
|
||||
<span class="lineno"> 83 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">concatMap dropNulls</span></span>
|
||||
<span class="lineno"> 84 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[DefinitionTree $ d & groupChildren %~ concatMap worker]</span></span>
|
||||
<span class="lineno"> 85 </span><span class="spaces"> </span><span class="istickedoff">worker (GroupTree g)</span>
|
||||
<span class="lineno"> 86 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">g ^. drawAttributes == defaultSvg</span> =</span>
|
||||
<span class="lineno"> 87 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">concatMap dropNulls $</span></span>
|
||||
<span class="lineno"> 88 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">concatMap worker (g^.groupChildren)</span></span>
|
||||
<span class="lineno"> 89 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span> =</span>
|
||||
<span class="lineno"> 90 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">dropNulls $</span></span>
|
||||
<span class="lineno"> 91 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">GroupTree $ g & groupChildren %~ concatMap worker</span></span>
|
||||
<span class="lineno"> 92 </span><span class="spaces"> </span><span class="istickedoff">worker t = dropNulls t</span>
|
||||
<span class="lineno"> 93 </span><span class="spaces"></span><span class="istickedoff"></span>
|
||||
<span class="lineno"> 94 </span><span class="spaces"> </span><span class="istickedoff">dropNulls None = <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 95 </span><span class="spaces"> </span><span class="istickedoff">dropNulls (DefinitionTree d)</span>
|
||||
<span class="lineno"> 96 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">null (d^.groupChildren)</span> = <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 97 </span><span class="spaces"> </span><span class="istickedoff">dropNulls (GroupTree g)</span>
|
||||
<span class="lineno"> 98 </span><span class="spaces"> </span><span class="istickedoff">| <span class="nottickedoff">null (g^.groupChildren)</span> = <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 99 </span><span class="spaces"> </span><span class="istickedoff">dropNulls t = [t]</span></span>
|
||||
<span class="lineno"> 100 </span>
|
||||
<span class="lineno"> 101 </span>-- | Separate grouped items. This is required by clip nodes.
|
||||
<span class="lineno"> 102 </span>--
|
||||
<span class="lineno"> 103 </span>-- @removeGroups (withFillColor "blue" $ mkGroup [mkCircle 1, mkRect 1 1])
|
||||
<span class="lineno"> 104 </span>-- = [ withFillColor "blue" $ mkCircle 1
|
||||
<span class="lineno"> 105 </span>-- , withFillColor "blue" $ mkRect 1 1 ]@
|
||||
<span class="lineno"> 106 </span>removeGroups :: Tree -> [Tree]
|
||||
<span class="lineno"> 107 </span><span class="decl"><span class="nottickedoff">removeGroups = worker defaultSvg</span>
|
||||
<span class="lineno"> 108 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="nottickedoff">worker _attr None = []</span>
|
||||
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="nottickedoff">worker _attr (DefinitionTree d) =</span>
|
||||
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="nottickedoff">concatMap dropNulls</span>
|
||||
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="nottickedoff">[DefinitionTree $ d & groupChildren %~ concatMap (worker defaultSvg)]</span>
|
||||
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="nottickedoff">worker attr (GroupTree g)</span>
|
||||
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="nottickedoff">| g ^. drawAttributes == defaultSvg =</span>
|
||||
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="nottickedoff">concatMap dropNulls $</span>
|
||||
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="nottickedoff">concatMap (worker attr) (g^.groupChildren)</span>
|
||||
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise =</span>
|
||||
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="nottickedoff">concatMap (worker (attr <> g ^. drawAttributes)) (g^.groupChildren)</span>
|
||||
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="nottickedoff">worker attr t = dropNulls (t & drawAttributes .~ attr)</span>
|
||||
<span class="lineno"> 120 </span><span class="spaces"></span><span class="nottickedoff"></span>
|
||||
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="nottickedoff">dropNulls None = []</span>
|
||||
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="nottickedoff">dropNulls (DefinitionTree d)</span>
|
||||
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="nottickedoff">| null (d^.groupChildren) = []</span>
|
||||
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="nottickedoff">dropNulls (GroupTree g)</span>
|
||||
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="nottickedoff">| null (g^.groupChildren) = []</span>
|
||||
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="nottickedoff">dropNulls t = [t]</span></span>
|
||||
<span class="lineno"> 127 </span>
|
||||
<span class="lineno"> 128 </span>-- | Extract all path commands from a node (and its children) and concatenate them.
|
||||
<span class="lineno"> 129 </span>extractPath :: Tree -> [PathCommand]
|
||||
<span class="lineno"> 130 </span><span class="decl"><span class="istickedoff">extractPath = worker . simplify . lowerTransformations . pathify</span>
|
||||
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="istickedoff">worker (GroupTree g) = <span class="nottickedoff">concatMap worker (g^.groupChildren)</span></span>
|
||||
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="istickedoff">worker (PathTree p) = p^.pathDefinition</span>
|
||||
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="istickedoff">worker _ = <span class="nottickedoff">[]</span></span></span>
|
||||
<span class="lineno"> 135 </span>
|
||||
<span class="lineno"> 136 </span>withSubglyphs :: [Int] -> (Tree -> Tree) -> Tree -> Tree
|
||||
<span class="lineno"> 137 </span><span class="decl"><span class="nottickedoff">withSubglyphs target fn = \t -> evalState (worker t) 0</span>
|
||||
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="nottickedoff">worker :: Tree -> State Int Tree</span>
|
||||
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="nottickedoff">worker t =</span>
|
||||
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="nottickedoff">case t of</span>
|
||||
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree g -> do</span>
|
||||
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="nottickedoff">cs <- mapM worker (g ^. groupChildren)</span>
|
||||
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="nottickedoff">return $ GroupTree $ g & groupChildren .~ cs</span>
|
||||
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="nottickedoff">PathTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="nottickedoff">CircleTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="nottickedoff">PolyLineTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="nottickedoff">PolygonTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="nottickedoff">EllipseTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="nottickedoff">LineTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="nottickedoff">RectangleTree{} -> handleGlyph t</span>
|
||||
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="nottickedoff">_ -> return t</span>
|
||||
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="nottickedoff">handleGlyph :: Tree -> State Int Tree</span>
|
||||
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="nottickedoff">handleGlyph svg = do</span>
|
||||
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="nottickedoff">n <- get <* modify (+1)</span>
|
||||
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="nottickedoff">if n `elem` target</span>
|
||||
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="nottickedoff">then return $ fn svg</span>
|
||||
<span class="lineno"> 158 </span><span class="spaces"> </span><span class="nottickedoff">else return svg</span></span>
|
||||
<span class="lineno"> 159 </span>
|
||||
<span class="lineno"> 160 </span>splitGlyphs :: [Int] -> Tree -> (Tree, Tree)
|
||||
<span class="lineno"> 161 </span><span class="decl"><span class="nottickedoff">splitGlyphs target = \t -></span>
|
||||
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="nottickedoff">let (_, l, r) = execState (worker id t) (0, [], [])</span>
|
||||
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="nottickedoff">in (mkGroup l, mkGroup r)</span>
|
||||
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="nottickedoff">handleGlyph :: Tree -> State (Int, [Tree], [Tree]) ()</span>
|
||||
<span class="lineno"> 166 </span><span class="spaces"> </span><span class="nottickedoff">handleGlyph t = do</span>
|
||||
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="nottickedoff">(n, l, r) <- get</span>
|
||||
<span class="lineno"> 168 </span><span class="spaces"> </span><span class="nottickedoff">if n `elem` target</span>
|
||||
<span class="lineno"> 169 </span><span class="spaces"> </span><span class="nottickedoff">then put (n+1, l, t:r)</span>
|
||||
<span class="lineno"> 170 </span><span class="spaces"> </span><span class="nottickedoff">else put (n+1, t:l, r)</span>
|
||||
<span class="lineno"> 171 </span><span class="spaces"> </span><span class="nottickedoff">worker :: (Tree -> Tree) -> Tree -> State (Int, [Tree], [Tree]) ()</span>
|
||||
<span class="lineno"> 172 </span><span class="spaces"> </span><span class="nottickedoff">worker acc t =</span>
|
||||
<span class="lineno"> 173 </span><span class="spaces"> </span><span class="nottickedoff">case t of</span>
|
||||
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="nottickedoff">GroupTree g -> do</span>
|
||||
<span class="lineno"> 175 </span><span class="spaces"> </span><span class="nottickedoff">let acc' sub = acc (GroupTree $ g & groupChildren .~ [sub])</span>
|
||||
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="nottickedoff">mapM_ (worker acc') (g ^. groupChildren)</span>
|
||||
<span class="lineno"> 177 </span><span class="spaces"> </span><span class="nottickedoff">PathTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="nottickedoff">CircleTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 179 </span><span class="spaces"> </span><span class="nottickedoff">PolyLineTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 180 </span><span class="spaces"> </span><span class="nottickedoff">PolygonTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="nottickedoff">EllipseTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 182 </span><span class="spaces"> </span><span class="nottickedoff">LineTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="nottickedoff">RectangleTree{} -> handleGlyph $ acc t</span>
|
||||
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="nottickedoff">DefinitionTree{} -> return ()</span>
|
||||
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="nottickedoff">_ -></span>
|
||||
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="nottickedoff">modify $ \(n, l, r) -> (n, acc t:l, r)</span></span>
|
||||
<span class="lineno"> 187 </span>{-
|
||||
<span class="lineno"> 188 </span><g transform="translate(10,10)">
|
||||
<span class="lineno"> 189 </span> <g transform="scale(2)">
|
||||
<span class="lineno"> 190 </span> <circle/>
|
||||
<span class="lineno"> 191 </span> </g>
|
||||
<span class="lineno"> 192 </span> <g transform="scale(0.5)">
|
||||
<span class="lineno"> 193 </span> <rect/>
|
||||
<span class="lineno"> 194 </span> </g>
|
||||
<span class="lineno"> 195 </span></g>
|
||||
<span class="lineno"> 196 </span>
|
||||
<span class="lineno"> 197 </span>{-| Convert primitive SVG shapes (like those created by 'mkCircle', 'mkRect', 'mkLine' or
|
||||
<span class="lineno"> 198 </span> 'mkEllipse') into SVG path. This can be useful for creating animations of these shapes being
|
||||
<span class="lineno"> 199 </span> drawn progressively with 'partialSvg'.
|
||||
<span class="lineno"> 200 </span>
|
||||
<span class="lineno"> 201 </span> Example:
|
||||
<span class="lineno"> 202 </span>
|
||||
<span class="lineno"> 203 </span> > pathifyExample :: Animation
|
||||
<span class="lineno"> 204 </span> > pathifyExample = animate $ \t -> gridLayout
|
||||
<span class="lineno"> 205 </span> > [ [ partialSvg t $ pathify $ mkCircle 1
|
||||
<span class="lineno"> 206 </span> > , partialSvg t $ pathify $ mkRect 2 2
|
||||
<span class="lineno"> 207 </span> > ]
|
||||
<span class="lineno"> 208 </span> > , [ partialSvg t $ pathify $ mkEllipse 1 0.5
|
||||
<span class="lineno"> 209 </span> > , partialSvg t $ pathify $ mkLine (-1, -1) (1, 1)
|
||||
<span class="lineno"> 210 </span> > ]
|
||||
<span class="lineno"> 211 </span> > ]
|
||||
<span class="lineno"> 212 </span>
|
||||
<span class="lineno"> 213 </span> <<docs/gifs/doc_pathify.gif>>
|
||||
<span class="lineno"> 214 </span> -}
|
||||
<span class="lineno"> 215 </span>pathify :: Tree -> Tree
|
||||
<span class="lineno"> 216 </span><span class="decl"><span class="istickedoff">pathify = mapTree worker</span>
|
||||
<span class="lineno"> 217 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 218 </span><span class="spaces"> </span><span class="istickedoff">worker =</span>
|
||||
<span class="lineno"> 219 </span><span class="spaces"> </span><span class="istickedoff">\case</span>
|
||||
<span class="lineno"> 220 </span><span class="spaces"> </span><span class="istickedoff">RectangleTree rect | Just (x,y,w,h) <- unpackRect rect -></span>
|
||||
<span class="lineno"> 221 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 222 </span><span class="spaces"> </span><span class="istickedoff">& drawAttributes .~ rect ^. drawAttributes</span>
|
||||
<span class="lineno"> 223 </span><span class="spaces"> </span><span class="istickedoff">& strokeLineCap .~ pure CapSquare</span>
|
||||
<span class="lineno"> 224 </span><span class="spaces"> </span><span class="istickedoff">& pathDefinition .~</span>
|
||||
<span class="lineno"> 225 </span><span class="spaces"> </span><span class="istickedoff">[MoveTo OriginAbsolute [V2 x y]</span>
|
||||
<span class="lineno"> 226 </span><span class="spaces"> </span><span class="istickedoff">,HorizontalTo OriginRelative [w]</span>
|
||||
<span class="lineno"> 227 </span><span class="spaces"> </span><span class="istickedoff">,VerticalTo OriginRelative [h]</span>
|
||||
<span class="lineno"> 228 </span><span class="spaces"> </span><span class="istickedoff">,HorizontalTo OriginRelative [-w]</span>
|
||||
<span class="lineno"> 229 </span><span class="spaces"> </span><span class="istickedoff">,EndPath ]</span>
|
||||
<span class="lineno"> 230 </span><span class="spaces"> </span><span class="istickedoff">LineTree line | Just (x1,y1, x2, y2) <- unpackLine line -></span>
|
||||
<span class="lineno"> 231 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 232 </span><span class="spaces"> </span><span class="istickedoff">& drawAttributes .~ line ^. drawAttributes</span>
|
||||
<span class="lineno"> 233 </span><span class="spaces"> </span><span class="istickedoff">& pathDefinition .~</span>
|
||||
<span class="lineno"> 234 </span><span class="spaces"> </span><span class="istickedoff">[MoveTo OriginAbsolute [V2 x1 y1]</span>
|
||||
<span class="lineno"> 235 </span><span class="spaces"> </span><span class="istickedoff">,LineTo OriginAbsolute [V2 x2 y2] ]</span>
|
||||
<span class="lineno"> 236 </span><span class="spaces"> </span><span class="istickedoff">CircleTree circ | Just (x, y, r) <- unpackCircle circ -></span>
|
||||
<span class="lineno"> 237 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 238 </span><span class="spaces"> </span><span class="istickedoff">& drawAttributes .~ circ ^. drawAttributes</span>
|
||||
<span class="lineno"> 197 </span>[ (\svg -> <g transform="translate(10,10)"><g transform="scale(2)">svg</g></g>, <circle/>)
|
||||
<span class="lineno"> 198 </span>, (\svg -> <g transform="translate(10,10)"><g transform="scale(0.5)">svg</g></g>, <rect/>)]
|
||||
<span class="lineno"> 199 </span>-}
|
||||
<span class="lineno"> 200 </span>svgGlyphs :: Tree -> [(Tree -> Tree, DrawAttributes, Tree)]
|
||||
<span class="lineno"> 201 </span><span class="decl"><span class="istickedoff">svgGlyphs = worker <span class="nottickedoff">id</span> defaultSvg</span>
|
||||
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="istickedoff">worker acc attr =</span>
|
||||
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="istickedoff">\case</span>
|
||||
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="istickedoff">None -> <span class="nottickedoff">[]</span></span>
|
||||
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="istickedoff">GroupTree g -></span>
|
||||
<span class="lineno"> 207 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let acc' sub = acc (GroupTree $ g & groupChildren .~ [sub])</span></span>
|
||||
<span class="lineno"> 208 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">attr' = (g^.drawAttributes) `mappend` attr</span></span>
|
||||
<span class="lineno"> 209 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in concatMap (worker acc' attr') (g ^. groupChildren)</span></span>
|
||||
<span class="lineno"> 210 </span><span class="spaces"> </span><span class="istickedoff">t -> [(<span class="nottickedoff">acc</span>, (t^.drawAttributes) `mappend` attr, t)]</span></span>
|
||||
<span class="lineno"> 211 </span>
|
||||
<span class="lineno"> 212 </span>{-| Convert primitive SVG shapes (like those created by 'mkCircle', 'mkRect', 'mkLine' or
|
||||
<span class="lineno"> 213 </span> 'mkEllipse') into SVG path. This can be useful for creating animations of these shapes being
|
||||
<span class="lineno"> 214 </span> drawn progressively with 'partialSvg'.
|
||||
<span class="lineno"> 215 </span>
|
||||
<span class="lineno"> 216 </span> Example:
|
||||
<span class="lineno"> 217 </span>
|
||||
<span class="lineno"> 218 </span> > pathifyExample :: Animation
|
||||
<span class="lineno"> 219 </span> > pathifyExample = animate $ \t -> gridLayout
|
||||
<span class="lineno"> 220 </span> > [ [ partialSvg t $ pathify $ mkCircle 1
|
||||
<span class="lineno"> 221 </span> > , partialSvg t $ pathify $ mkRect 2 2
|
||||
<span class="lineno"> 222 </span> > ]
|
||||
<span class="lineno"> 223 </span> > , [ partialSvg t $ pathify $ mkEllipse 1 0.5
|
||||
<span class="lineno"> 224 </span> > , partialSvg t $ pathify $ mkLine (-1, -1) (1, 1)
|
||||
<span class="lineno"> 225 </span> > ]
|
||||
<span class="lineno"> 226 </span> > ]
|
||||
<span class="lineno"> 227 </span>
|
||||
<span class="lineno"> 228 </span> <<docs/gifs/doc_pathify.gif>>
|
||||
<span class="lineno"> 229 </span> -}
|
||||
<span class="lineno"> 230 </span>pathify :: Tree -> Tree
|
||||
<span class="lineno"> 231 </span><span class="decl"><span class="istickedoff">pathify = mapTree worker</span>
|
||||
<span class="lineno"> 232 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 233 </span><span class="spaces"> </span><span class="istickedoff">worker =</span>
|
||||
<span class="lineno"> 234 </span><span class="spaces"> </span><span class="istickedoff">\case</span>
|
||||
<span class="lineno"> 235 </span><span class="spaces"> </span><span class="istickedoff">RectangleTree rect | Just (x,y,w,h) <- unpackRect rect -></span>
|
||||
<span class="lineno"> 236 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 237 </span><span class="spaces"> </span><span class="istickedoff">& drawAttributes .~ rect ^. drawAttributes</span>
|
||||
<span class="lineno"> 238 </span><span class="spaces"> </span><span class="istickedoff">& strokeLineCap .~ pure CapSquare</span>
|
||||
<span class="lineno"> 239 </span><span class="spaces"> </span><span class="istickedoff">& pathDefinition .~</span>
|
||||
<span class="lineno"> 240 </span><span class="spaces"> </span><span class="istickedoff">[MoveTo OriginAbsolute [V2 (x-r) y]</span>
|
||||
<span class="lineno"> 241 </span><span class="spaces"> </span><span class="istickedoff">,EllipticalArc OriginRelative [(r, r, 0,True,False,V2 (r*2) 0)</span>
|
||||
<span class="lineno"> 242 </span><span class="spaces"> </span><span class="istickedoff">,(r, r, 0,True,False,V2 (-r*2) 0)]]</span>
|
||||
<span class="lineno"> 243 </span><span class="spaces"> </span><span class="istickedoff">PolyLineTree pl -></span>
|
||||
<span class="lineno"> 244 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let points = pl ^. polyLinePoints</span></span>
|
||||
<span class="lineno"> 245 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in PathTree $ defaultSvg</span></span>
|
||||
<span class="lineno"> 246 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& drawAttributes .~ pl ^. drawAttributes</span></span>
|
||||
<span class="lineno"> 247 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& pathDefinition .~ pointsToPathCommands points</span></span>
|
||||
<span class="lineno"> 248 </span><span class="spaces"> </span><span class="istickedoff">PolygonTree pg -></span>
|
||||
<span class="lineno"> 249 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let points = pg ^. polygonPoints</span></span>
|
||||
<span class="lineno"> 250 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in PathTree $ defaultSvg</span></span>
|
||||
<span class="lineno"> 251 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& drawAttributes .~ pg ^. drawAttributes</span></span>
|
||||
<span class="lineno"> 252 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">-- Polygon automatically connects the last point to the first. For path we must do</span></span>
|
||||
<span class="lineno"> 253 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">-- it explicitly</span></span>
|
||||
<span class="lineno"> 254 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& pathDefinition .~ (pointsToPathCommands points ++ [EndPath])</span></span>
|
||||
<span class="lineno"> 255 </span><span class="spaces"> </span><span class="istickedoff">EllipseTree elip | Just (cx,cy,rx,ry) <- unpackEllipse elip -></span>
|
||||
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="istickedoff">& drawAttributes .~ elip ^. drawAttributes</span>
|
||||
<span class="lineno"> 258 </span><span class="spaces"> </span><span class="istickedoff">& pathDefinition .~</span>
|
||||
<span class="lineno"> 259 </span><span class="spaces"> </span><span class="istickedoff">[ MoveTo OriginAbsolute [V2 (cx-rx) cy]</span>
|
||||
<span class="lineno"> 260 </span><span class="spaces"> </span><span class="istickedoff">, EllipticalArc OriginRelative [(rx, ry, 0,True,False,V2 (rx*2) 0)</span>
|
||||
<span class="lineno"> 261 </span><span class="spaces"> </span><span class="istickedoff">,(rx, ry, 0,True,False,V2 (-rx*2) 0)]]</span>
|
||||
<span class="lineno"> 262 </span><span class="spaces"> </span><span class="istickedoff">t -> t</span>
|
||||
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="istickedoff">unpackCircle circ = do</span>
|
||||
<span class="lineno"> 264 </span><span class="spaces"> </span><span class="istickedoff">let (x,y) = circ ^. circleCenter</span>
|
||||
<span class="lineno"> 265 </span><span class="spaces"> </span><span class="istickedoff">liftM3 (,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ circ ^. circleRadius)</span>
|
||||
<span class="lineno"> 266 </span><span class="spaces"> </span><span class="istickedoff">unpackEllipse elip = do</span>
|
||||
<span class="lineno"> 267 </span><span class="spaces"> </span><span class="istickedoff">let (x,y) = elip ^. ellipseCenter</span>
|
||||
<span class="lineno"> 268 </span><span class="spaces"> </span><span class="istickedoff">liftM4 (,,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ elip ^. ellipseXRadius)</span>
|
||||
<span class="lineno"> 269 </span><span class="spaces"> </span><span class="istickedoff">(unpackNumber $ elip ^. ellipseYRadius)</span>
|
||||
<span class="lineno"> 270 </span><span class="spaces"> </span><span class="istickedoff">unpackLine line = do</span>
|
||||
<span class="lineno"> 271 </span><span class="spaces"> </span><span class="istickedoff">let (x1,y1) = line ^. linePoint1</span>
|
||||
<span class="lineno"> 272 </span><span class="spaces"> </span><span class="istickedoff">(x2,y2) = line ^. linePoint2</span>
|
||||
<span class="lineno"> 273 </span><span class="spaces"> </span><span class="istickedoff">liftM4 (,,,) (unpackNumber x1) (unpackNumber y1) (unpackNumber x2) (unpackNumber y2)</span>
|
||||
<span class="lineno"> 274 </span><span class="spaces"> </span><span class="istickedoff">unpackRect rect = do</span>
|
||||
<span class="lineno"> 275 </span><span class="spaces"> </span><span class="istickedoff">let (x', y') = rect ^. rectUpperLeftCorner</span>
|
||||
<span class="lineno"> 276 </span><span class="spaces"> </span><span class="istickedoff">x <- unpackNumber x'</span>
|
||||
<span class="lineno"> 277 </span><span class="spaces"> </span><span class="istickedoff">y <- unpackNumber y'</span>
|
||||
<span class="lineno"> 278 </span><span class="spaces"> </span><span class="istickedoff">w <- unpackNumber =<< rect ^. rectWidth</span>
|
||||
<span class="lineno"> 279 </span><span class="spaces"> </span><span class="istickedoff">h <- unpackNumber =<< rect ^. rectHeight</span>
|
||||
<span class="lineno"> 280 </span><span class="spaces"> </span><span class="istickedoff">return (x,y,w,h)</span>
|
||||
<span class="lineno"> 281 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pointsToPathCommands points = case points of</span></span>
|
||||
<span class="lineno"> 282 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[] -> []</span></span>
|
||||
<span class="lineno"> 283 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(p:ps) -> [ MoveTo OriginAbsolute [p]</span></span>
|
||||
<span class="lineno"> 284 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, LineTo OriginAbsolute ps ]</span></span>
|
||||
<span class="lineno"> 285 </span><span class="spaces"> </span><span class="istickedoff">unpackNumber n =</span>
|
||||
<span class="lineno"> 286 </span><span class="spaces"> </span><span class="istickedoff">case toUserUnit <span class="nottickedoff">defaultDPI</span> n of</span>
|
||||
<span class="lineno"> 287 </span><span class="spaces"> </span><span class="istickedoff">Num d -> Just d</span>
|
||||
<span class="lineno"> 288 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">Nothing</span></span></span>
|
||||
<span class="lineno"> 289 </span>
|
||||
<span class="lineno"> 290 </span>mapSvgPaths :: ([PathCommand] -> [PathCommand]) -> SVG -> SVG
|
||||
<span class="lineno"> 291 </span><span class="decl"><span class="nottickedoff">mapSvgPaths fn = mapTree worker</span>
|
||||
<span class="lineno"> 292 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 293 </span><span class="spaces"> </span><span class="nottickedoff">worker =</span>
|
||||
<span class="lineno"> 294 </span><span class="spaces"> </span><span class="nottickedoff">\case</span>
|
||||
<span class="lineno"> 295 </span><span class="spaces"> </span><span class="nottickedoff">PathTree path -> PathTree $</span>
|
||||
<span class="lineno"> 296 </span><span class="spaces"> </span><span class="nottickedoff">path & pathDefinition %~ fn</span>
|
||||
<span class="lineno"> 297 </span><span class="spaces"> </span><span class="nottickedoff">t -> t</span></span>
|
||||
<span class="lineno"> 298 </span>
|
||||
<span class="lineno"> 299 </span>mapSvgLines :: ([LineCommand] -> [LineCommand]) -> SVG -> SVG
|
||||
<span class="lineno"> 300 </span><span class="decl"><span class="nottickedoff">mapSvgLines fn = mapSvgPaths (lineToPath . fn . toLineCommands)</span></span>
|
||||
<span class="lineno"> 301 </span>
|
||||
<span class="lineno"> 302 </span>-- Only maps points in paths
|
||||
<span class="lineno"> 303 </span>mapSvgPoints :: (RPoint -> RPoint) -> SVG -> SVG
|
||||
<span class="lineno"> 304 </span><span class="decl"><span class="nottickedoff">mapSvgPoints fn = mapSvgLines (map worker)</span>
|
||||
<span class="lineno"> 305 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 306 </span><span class="spaces"> </span><span class="nottickedoff">worker (LineMove p) = LineMove (fn p)</span>
|
||||
<span class="lineno"> 307 </span><span class="spaces"> </span><span class="nottickedoff">worker (LineBezier ps) = LineBezier (map fn ps)</span>
|
||||
<span class="lineno"> 308 </span><span class="spaces"> </span><span class="nottickedoff">worker (LineEnd p) = LineEnd (fn p)</span></span>
|
||||
<span class="lineno"> 309 </span>
|
||||
<span class="lineno"> 310 </span>svgPointsToRadians :: SVG -> SVG
|
||||
<span class="lineno"> 311 </span><span class="decl"><span class="nottickedoff">svgPointsToRadians = mapSvgPoints worker</span>
|
||||
<span class="lineno"> 312 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 313 </span><span class="spaces"> </span><span class="nottickedoff">worker (V2 x y) = V2 (x/180*pi) (y/180*pi)</span></span>
|
||||
<span class="lineno"> 240 </span><span class="spaces"> </span><span class="istickedoff">[MoveTo OriginAbsolute [V2 x y]</span>
|
||||
<span class="lineno"> 241 </span><span class="spaces"> </span><span class="istickedoff">,HorizontalTo OriginRelative [w]</span>
|
||||
<span class="lineno"> 242 </span><span class="spaces"> </span><span class="istickedoff">,VerticalTo OriginRelative [h]</span>
|
||||
<span class="lineno"> 243 </span><span class="spaces"> </span><span class="istickedoff">,HorizontalTo OriginRelative [-w]</span>
|
||||
<span class="lineno"> 244 </span><span class="spaces"> </span><span class="istickedoff">,EndPath ]</span>
|
||||
<span class="lineno"> 245 </span><span class="spaces"> </span><span class="istickedoff">LineTree line | Just (x1,y1, x2, y2) <- unpackLine line -></span>
|
||||
<span class="lineno"> 246 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 247 </span><span class="spaces"> </span><span class="istickedoff">& drawAttributes .~ line ^. drawAttributes</span>
|
||||
<span class="lineno"> 248 </span><span class="spaces"> </span><span class="istickedoff">& pathDefinition .~</span>
|
||||
<span class="lineno"> 249 </span><span class="spaces"> </span><span class="istickedoff">[MoveTo OriginAbsolute [V2 x1 y1]</span>
|
||||
<span class="lineno"> 250 </span><span class="spaces"> </span><span class="istickedoff">,LineTo OriginAbsolute [V2 x2 y2] ]</span>
|
||||
<span class="lineno"> 251 </span><span class="spaces"> </span><span class="istickedoff">CircleTree circ | Just (x, y, r) <- unpackCircle circ -></span>
|
||||
<span class="lineno"> 252 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 253 </span><span class="spaces"> </span><span class="istickedoff">& drawAttributes .~ circ ^. drawAttributes</span>
|
||||
<span class="lineno"> 254 </span><span class="spaces"> </span><span class="istickedoff">& pathDefinition .~</span>
|
||||
<span class="lineno"> 255 </span><span class="spaces"> </span><span class="istickedoff">[MoveTo OriginAbsolute [V2 (x-r) y]</span>
|
||||
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="istickedoff">,EllipticalArc OriginRelative [(r, r, 0,True,False,V2 (r*2) 0)</span>
|
||||
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="istickedoff">,(r, r, 0,True,False,V2 (-r*2) 0)]]</span>
|
||||
<span class="lineno"> 258 </span><span class="spaces"> </span><span class="istickedoff">PolyLineTree pl -></span>
|
||||
<span class="lineno"> 259 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let points = pl ^. polyLinePoints</span></span>
|
||||
<span class="lineno"> 260 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in PathTree $ defaultSvg</span></span>
|
||||
<span class="lineno"> 261 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& drawAttributes .~ pl ^. drawAttributes</span></span>
|
||||
<span class="lineno"> 262 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& pathDefinition .~ pointsToPathCommands points</span></span>
|
||||
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="istickedoff">PolygonTree pg -></span>
|
||||
<span class="lineno"> 264 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let points = pg ^. polygonPoints</span></span>
|
||||
<span class="lineno"> 265 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">in PathTree $ defaultSvg</span></span>
|
||||
<span class="lineno"> 266 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& drawAttributes .~ pg ^. drawAttributes</span></span>
|
||||
<span class="lineno"> 267 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">-- Polygon automatically connects the last point to the first. For path we must do</span></span>
|
||||
<span class="lineno"> 268 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">-- it explicitly</span></span>
|
||||
<span class="lineno"> 269 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">& pathDefinition .~ (pointsToPathCommands points ++ [EndPath])</span></span>
|
||||
<span class="lineno"> 270 </span><span class="spaces"> </span><span class="istickedoff">EllipseTree elip | Just (cx,cy,rx,ry) <- unpackEllipse elip -></span>
|
||||
<span class="lineno"> 271 </span><span class="spaces"> </span><span class="istickedoff">PathTree $ defaultSvg</span>
|
||||
<span class="lineno"> 272 </span><span class="spaces"> </span><span class="istickedoff">& drawAttributes .~ elip ^. drawAttributes</span>
|
||||
<span class="lineno"> 273 </span><span class="spaces"> </span><span class="istickedoff">& pathDefinition .~</span>
|
||||
<span class="lineno"> 274 </span><span class="spaces"> </span><span class="istickedoff">[ MoveTo OriginAbsolute [V2 (cx-rx) cy]</span>
|
||||
<span class="lineno"> 275 </span><span class="spaces"> </span><span class="istickedoff">, EllipticalArc OriginRelative [(rx, ry, 0,True,False,V2 (rx*2) 0)</span>
|
||||
<span class="lineno"> 276 </span><span class="spaces"> </span><span class="istickedoff">,(rx, ry, 0,True,False,V2 (-rx*2) 0)]]</span>
|
||||
<span class="lineno"> 277 </span><span class="spaces"> </span><span class="istickedoff">t -> t</span>
|
||||
<span class="lineno"> 278 </span><span class="spaces"> </span><span class="istickedoff">unpackCircle circ = do</span>
|
||||
<span class="lineno"> 279 </span><span class="spaces"> </span><span class="istickedoff">let (x,y) = circ ^. circleCenter</span>
|
||||
<span class="lineno"> 280 </span><span class="spaces"> </span><span class="istickedoff">liftM3 (,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ circ ^. circleRadius)</span>
|
||||
<span class="lineno"> 281 </span><span class="spaces"> </span><span class="istickedoff">unpackEllipse elip = do</span>
|
||||
<span class="lineno"> 282 </span><span class="spaces"> </span><span class="istickedoff">let (x,y) = elip ^. ellipseCenter</span>
|
||||
<span class="lineno"> 283 </span><span class="spaces"> </span><span class="istickedoff">liftM4 (,,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ elip ^. ellipseXRadius)</span>
|
||||
<span class="lineno"> 284 </span><span class="spaces"> </span><span class="istickedoff">(unpackNumber $ elip ^. ellipseYRadius)</span>
|
||||
<span class="lineno"> 285 </span><span class="spaces"> </span><span class="istickedoff">unpackLine line = do</span>
|
||||
<span class="lineno"> 286 </span><span class="spaces"> </span><span class="istickedoff">let (x1,y1) = line ^. linePoint1</span>
|
||||
<span class="lineno"> 287 </span><span class="spaces"> </span><span class="istickedoff">(x2,y2) = line ^. linePoint2</span>
|
||||
<span class="lineno"> 288 </span><span class="spaces"> </span><span class="istickedoff">liftM4 (,,,) (unpackNumber x1) (unpackNumber y1) (unpackNumber x2) (unpackNumber y2)</span>
|
||||
<span class="lineno"> 289 </span><span class="spaces"> </span><span class="istickedoff">unpackRect rect = do</span>
|
||||
<span class="lineno"> 290 </span><span class="spaces"> </span><span class="istickedoff">let (x', y') = rect ^. rectUpperLeftCorner</span>
|
||||
<span class="lineno"> 291 </span><span class="spaces"> </span><span class="istickedoff">x <- unpackNumber x'</span>
|
||||
<span class="lineno"> 292 </span><span class="spaces"> </span><span class="istickedoff">y <- unpackNumber y'</span>
|
||||
<span class="lineno"> 293 </span><span class="spaces"> </span><span class="istickedoff">w <- unpackNumber =<< rect ^. rectWidth</span>
|
||||
<span class="lineno"> 294 </span><span class="spaces"> </span><span class="istickedoff">h <- unpackNumber =<< rect ^. rectHeight</span>
|
||||
<span class="lineno"> 295 </span><span class="spaces"> </span><span class="istickedoff">return (x,y,w,h)</span>
|
||||
<span class="lineno"> 296 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pointsToPathCommands points = case points of</span></span>
|
||||
<span class="lineno"> 297 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[] -> []</span></span>
|
||||
<span class="lineno"> 298 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(p:ps) -> [ MoveTo OriginAbsolute [p]</span></span>
|
||||
<span class="lineno"> 299 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, LineTo OriginAbsolute ps ]</span></span>
|
||||
<span class="lineno"> 300 </span><span class="spaces"> </span><span class="istickedoff">unpackNumber n =</span>
|
||||
<span class="lineno"> 301 </span><span class="spaces"> </span><span class="istickedoff">case toUserUnit <span class="nottickedoff">defaultDPI</span> n of</span>
|
||||
<span class="lineno"> 302 </span><span class="spaces"> </span><span class="istickedoff">Num d -> Just d</span>
|
||||
<span class="lineno"> 303 </span><span class="spaces"> </span><span class="istickedoff">_ -> <span class="nottickedoff">Nothing</span></span></span>
|
||||
<span class="lineno"> 304 </span>
|
||||
<span class="lineno"> 305 </span>mapSvgPaths :: ([PathCommand] -> [PathCommand]) -> SVG -> SVG
|
||||
<span class="lineno"> 306 </span><span class="decl"><span class="nottickedoff">mapSvgPaths fn = mapTree worker</span>
|
||||
<span class="lineno"> 307 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 308 </span><span class="spaces"> </span><span class="nottickedoff">worker =</span>
|
||||
<span class="lineno"> 309 </span><span class="spaces"> </span><span class="nottickedoff">\case</span>
|
||||
<span class="lineno"> 310 </span><span class="spaces"> </span><span class="nottickedoff">PathTree path -> PathTree $</span>
|
||||
<span class="lineno"> 311 </span><span class="spaces"> </span><span class="nottickedoff">path & pathDefinition %~ fn</span>
|
||||
<span class="lineno"> 312 </span><span class="spaces"> </span><span class="nottickedoff">t -> t</span></span>
|
||||
<span class="lineno"> 313 </span>
|
||||
<span class="lineno"> 314 </span>mapSvgLines :: ([LineCommand] -> [LineCommand]) -> SVG -> SVG
|
||||
<span class="lineno"> 315 </span><span class="decl"><span class="nottickedoff">mapSvgLines fn = mapSvgPaths (lineToPath . fn . toLineCommands)</span></span>
|
||||
<span class="lineno"> 316 </span>
|
||||
<span class="lineno"> 317 </span>-- Only maps points in paths
|
||||
<span class="lineno"> 318 </span>mapSvgPoints :: (RPoint -> RPoint) -> SVG -> SVG
|
||||
<span class="lineno"> 319 </span><span class="decl"><span class="nottickedoff">mapSvgPoints fn = mapSvgLines (map worker)</span>
|
||||
<span class="lineno"> 320 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 321 </span><span class="spaces"> </span><span class="nottickedoff">worker (LineMove p) = LineMove (fn p)</span>
|
||||
<span class="lineno"> 322 </span><span class="spaces"> </span><span class="nottickedoff">worker (LineBezier ps) = LineBezier (map fn ps)</span>
|
||||
<span class="lineno"> 323 </span><span class="spaces"> </span><span class="nottickedoff">worker (LineEnd p) = LineEnd (fn p)</span></span>
|
||||
<span class="lineno"> 324 </span>
|
||||
<span class="lineno"> 325 </span>svgPointsToRadians :: SVG -> SVG
|
||||
<span class="lineno"> 326 </span><span class="decl"><span class="nottickedoff">svgPointsToRadians = mapSvgPoints worker</span>
|
||||
<span class="lineno"> 327 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 328 </span><span class="spaces"> </span><span class="nottickedoff">worker (V2 x y) = V2 (x/180*pi) (y/180*pi)</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
|
|
|
|||
|
|
@ -18,66 +18,76 @@ span.spaces { background: white }
|
|||
</pre>
|
||||
<pre>
|
||||
<span class="lineno"> 1 </span>{-# LANGUAGE BangPatterns #-}
|
||||
<span class="lineno"> 2 </span>{-# LANGUAGE PackageImports #-}
|
||||
<span class="lineno"> 3 </span>module Reanimate.Transform
|
||||
<span class="lineno"> 4 </span> ( identity
|
||||
<span class="lineno"> 5 </span> , transformPoint
|
||||
<span class="lineno"> 6 </span> , mkMatrix
|
||||
<span class="lineno"> 7 </span> , toTransformation
|
||||
<span class="lineno"> 8 </span> ) where
|
||||
<span class="lineno"> 9 </span>
|
||||
<span class="lineno"> 10 </span>-- XXX: Use Linear.Matrix instead of Data.Matrix to drop the 'matrix' dependency.
|
||||
<span class="lineno"> 11 </span>import Data.List
|
||||
<span class="lineno"> 12 </span>import "matrix" Data.Matrix (Matrix)
|
||||
<span class="lineno"> 13 </span>import qualified "matrix" Data.Matrix as M
|
||||
<span class="lineno"> 14 </span>import Data.Maybe
|
||||
<span class="lineno"> 15 </span>import Graphics.SvgTree
|
||||
<span class="lineno"> 16 </span>import Linear.V2
|
||||
<span class="lineno"> 17 </span>
|
||||
<span class="lineno"> 18 </span>type TMatrix = Matrix Coord
|
||||
<span class="lineno"> 19 </span>
|
||||
<span class="lineno"> 20 </span>identity :: TMatrix
|
||||
<span class="lineno"> 21 </span><span class="decl"><span class="istickedoff">identity = M.identity 3</span></span>
|
||||
<span class="lineno"> 2 </span>{-|
|
||||
<span class="lineno"> 3 </span> 2D transformation matrices capable of translating, scaling,
|
||||
<span class="lineno"> 4 </span> rotating, and skewing.
|
||||
<span class="lineno"> 5 </span>-}
|
||||
<span class="lineno"> 6 </span>module Reanimate.Transform
|
||||
<span class="lineno"> 7 </span> ( identity
|
||||
<span class="lineno"> 8 </span> , transformPoint
|
||||
<span class="lineno"> 9 </span> , mkMatrix
|
||||
<span class="lineno"> 10 </span> , toTransformation
|
||||
<span class="lineno"> 11 </span> ) where
|
||||
<span class="lineno"> 12 </span>
|
||||
<span class="lineno"> 13 </span>-- XXX: Use Linear.Matrix instead of Data.Matrix to drop the 'matrix' dependency.
|
||||
<span class="lineno"> 14 </span>import Data.List
|
||||
<span class="lineno"> 15 </span>import Data.Matrix (Matrix)
|
||||
<span class="lineno"> 16 </span>import qualified Data.Matrix as M
|
||||
<span class="lineno"> 17 </span>import Data.Maybe
|
||||
<span class="lineno"> 18 </span>import Graphics.SvgTree
|
||||
<span class="lineno"> 19 </span>import Linear.V2
|
||||
<span class="lineno"> 20 </span>
|
||||
<span class="lineno"> 21 </span>type TMatrix = Matrix Coord
|
||||
<span class="lineno"> 22 </span>
|
||||
<span class="lineno"> 23 </span>fromList :: [Coord] -> TMatrix
|
||||
<span class="lineno"> 24 </span><span class="decl"><span class="istickedoff">fromList [a,b,c,d,e,f] = M.fromList 3 3 [a,c,e,b,d,f,0,0,1]</span>
|
||||
<span class="lineno"> 25 </span><span class="spaces"></span><span class="istickedoff">fromList _ = <span class="nottickedoff">error "Reanimate.Transform.fromList: bad input"</span></span></span>
|
||||
<span class="lineno"> 26 </span>
|
||||
<span class="lineno"> 27 </span>transformPoint :: TMatrix -> RPoint -> RPoint
|
||||
<span class="lineno"> 28 </span><span class="decl"><span class="istickedoff">transformPoint m (V2 x y) = V2 (a*x +c*y + e) (b*x + d*y +f)</span>
|
||||
<span class="lineno"> 29 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 30 </span><span class="spaces"> </span><span class="istickedoff">!a = M.unsafeGet 1 1 m</span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"> </span><span class="istickedoff">!c = M.unsafeGet 1 2 m</span>
|
||||
<span class="lineno"> 32 </span><span class="spaces"> </span><span class="istickedoff">!e = M.unsafeGet 1 3 m</span>
|
||||
<span class="lineno"> 33 </span><span class="spaces"> </span><span class="istickedoff">!b = M.unsafeGet 2 1 m</span>
|
||||
<span class="lineno"> 34 </span><span class="spaces"> </span><span class="istickedoff">!d = M.unsafeGet 2 2 m</span>
|
||||
<span class="lineno"> 35 </span><span class="spaces"> </span><span class="istickedoff">!f = M.unsafeGet 2 3 m</span></span>
|
||||
<span class="lineno"> 36 </span> -- (a:c:e:b:d:f:_) = M.toList m
|
||||
<span class="lineno"> 37 </span>
|
||||
<span class="lineno"> 38 </span>mkMatrix :: Maybe [Transformation] -> TMatrix
|
||||
<span class="lineno"> 39 </span><span class="decl"><span class="istickedoff">mkMatrix Nothing = identity</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"></span><span class="istickedoff">mkMatrix (Just ts) = foldl' (*) identity (map transformationMatrix ts)</span></span>
|
||||
<span class="lineno"> 41 </span>
|
||||
<span class="lineno"> 42 </span>transformationMatrix :: Transformation -> TMatrix
|
||||
<span class="lineno"> 43 </span><span class="decl"><span class="istickedoff">transformationMatrix transformation =</span>
|
||||
<span class="lineno"> 44 </span><span class="spaces"> </span><span class="istickedoff">case transformation of</span>
|
||||
<span class="lineno"> 45 </span><span class="spaces"> </span><span class="istickedoff">TransformMatrix a b c d e f -> <span class="nottickedoff">fromList [a,b,c,d,e,f]</span></span>
|
||||
<span class="lineno"> 46 </span><span class="spaces"> </span><span class="istickedoff">Translate x y -> <span class="nottickedoff">translate x y</span></span>
|
||||
<span class="lineno"> 47 </span><span class="spaces"> </span><span class="istickedoff">Scale sx mbSy -> fromList [sx,0,0,fromMaybe <span class="nottickedoff">sx</span> mbSy,0,0]</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"> </span><span class="istickedoff">Rotate a Nothing -> <span class="nottickedoff">rotate a</span></span>
|
||||
<span class="lineno"> 49 </span><span class="spaces"> </span><span class="istickedoff">Rotate a (Just (x,y)) -> <span class="nottickedoff">translate x y * rotate a * translate (-x) (-y)</span></span>
|
||||
<span class="lineno"> 50 </span><span class="spaces"> </span><span class="istickedoff">SkewX a -> <span class="nottickedoff">fromList [1,0,tan (a*pi/180),1,0,0]</span></span>
|
||||
<span class="lineno"> 51 </span><span class="spaces"> </span><span class="istickedoff">SkewY a -> <span class="nottickedoff">fromList [1,tan (a*pi/180),0,1,0,0]</span></span>
|
||||
<span class="lineno"> 52 </span><span class="spaces"> </span><span class="istickedoff">TransformUnknown -> <span class="nottickedoff">identity</span></span>
|
||||
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">translate x y = fromList [1,0,0,1,x,y]</span></span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">rotate a = fromList [cos r,sin r,-sin r,cos r,0,0]</span></span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">where r = a * pi / 180</span></span></span>
|
||||
<span class="lineno"> 57 </span>
|
||||
<span class="lineno"> 58 </span>toTransformation :: TMatrix -> Transformation
|
||||
<span class="lineno"> 59 </span><span class="decl"><span class="nottickedoff">toTransformation m = TransformMatrix a b c d e f</span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="nottickedoff">[a,c,e,b,d,f,_,_,_] = M.toList m</span></span>
|
||||
<span class="lineno"> 23 </span>-- | Identity matrix.
|
||||
<span class="lineno"> 24 </span>--
|
||||
<span class="lineno"> 25 </span>-- @transformPoints identity x = x@
|
||||
<span class="lineno"> 26 </span>identity :: TMatrix
|
||||
<span class="lineno"> 27 </span><span class="decl"><span class="istickedoff">identity = M.identity 3</span></span>
|
||||
<span class="lineno"> 28 </span>
|
||||
<span class="lineno"> 29 </span>fromList :: [Coord] -> TMatrix
|
||||
<span class="lineno"> 30 </span><span class="decl"><span class="istickedoff">fromList [a,b,c,d,e,f] = M.fromList 3 3 [a,c,e,b,d,f,0,0,1]</span>
|
||||
<span class="lineno"> 31 </span><span class="spaces"></span><span class="istickedoff">fromList _ = <span class="nottickedoff">error "Reanimate.Transform.fromList: bad input"</span></span></span>
|
||||
<span class="lineno"> 32 </span>
|
||||
<span class="lineno"> 33 </span>-- | Apply a transformation matrix to a 2D point.
|
||||
<span class="lineno"> 34 </span>transformPoint :: TMatrix -> RPoint -> RPoint
|
||||
<span class="lineno"> 35 </span><span class="decl"><span class="istickedoff">transformPoint m (V2 x y) = V2 (a*x +c*y + e) (b*x + d*y +f)</span>
|
||||
<span class="lineno"> 36 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 37 </span><span class="spaces"> </span><span class="istickedoff">!a = M.unsafeGet 1 1 m</span>
|
||||
<span class="lineno"> 38 </span><span class="spaces"> </span><span class="istickedoff">!c = M.unsafeGet 1 2 m</span>
|
||||
<span class="lineno"> 39 </span><span class="spaces"> </span><span class="istickedoff">!e = M.unsafeGet 1 3 m</span>
|
||||
<span class="lineno"> 40 </span><span class="spaces"> </span><span class="istickedoff">!b = M.unsafeGet 2 1 m</span>
|
||||
<span class="lineno"> 41 </span><span class="spaces"> </span><span class="istickedoff">!d = M.unsafeGet 2 2 m</span>
|
||||
<span class="lineno"> 42 </span><span class="spaces"> </span><span class="istickedoff">!f = M.unsafeGet 2 3 m</span></span>
|
||||
<span class="lineno"> 43 </span> -- (a:c:e:b:d:f:_) = M.toList m
|
||||
<span class="lineno"> 44 </span>
|
||||
<span class="lineno"> 45 </span>-- | Convert multiple SVG transformations into a single transformation matrix.
|
||||
<span class="lineno"> 46 </span>mkMatrix :: Maybe [Transformation] -> TMatrix
|
||||
<span class="lineno"> 47 </span><span class="decl"><span class="istickedoff">mkMatrix Nothing = identity</span>
|
||||
<span class="lineno"> 48 </span><span class="spaces"></span><span class="istickedoff">mkMatrix (Just ts) = foldl' (*) identity (map transformationMatrix ts)</span></span>
|
||||
<span class="lineno"> 49 </span>
|
||||
<span class="lineno"> 50 </span>-- | Convert an SVG transformation into a transformation matrix.
|
||||
<span class="lineno"> 51 </span>transformationMatrix :: Transformation -> TMatrix
|
||||
<span class="lineno"> 52 </span><span class="decl"><span class="istickedoff">transformationMatrix transformation =</span>
|
||||
<span class="lineno"> 53 </span><span class="spaces"> </span><span class="istickedoff">case transformation of</span>
|
||||
<span class="lineno"> 54 </span><span class="spaces"> </span><span class="istickedoff">TransformMatrix a b c d e f -> <span class="nottickedoff">fromList [a,b,c,d,e,f]</span></span>
|
||||
<span class="lineno"> 55 </span><span class="spaces"> </span><span class="istickedoff">Translate x y -> <span class="nottickedoff">translate x y</span></span>
|
||||
<span class="lineno"> 56 </span><span class="spaces"> </span><span class="istickedoff">Scale sx mbSy -> fromList [sx,0,0,fromMaybe <span class="nottickedoff">sx</span> mbSy,0,0]</span>
|
||||
<span class="lineno"> 57 </span><span class="spaces"> </span><span class="istickedoff">Rotate a Nothing -> <span class="nottickedoff">rotate a</span></span>
|
||||
<span class="lineno"> 58 </span><span class="spaces"> </span><span class="istickedoff">Rotate a (Just (x,y)) -> <span class="nottickedoff">translate x y * rotate a * translate (-x) (-y)</span></span>
|
||||
<span class="lineno"> 59 </span><span class="spaces"> </span><span class="istickedoff">SkewX a -> <span class="nottickedoff">fromList [1,0,tan (a*pi/180),1,0,0]</span></span>
|
||||
<span class="lineno"> 60 </span><span class="spaces"> </span><span class="istickedoff">SkewY a -> <span class="nottickedoff">fromList [1,tan (a*pi/180),0,1,0,0]</span></span>
|
||||
<span class="lineno"> 61 </span><span class="spaces"> </span><span class="istickedoff">TransformUnknown -> <span class="nottickedoff">identity</span></span>
|
||||
<span class="lineno"> 62 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
||||
<span class="lineno"> 63 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">translate x y = fromList [1,0,0,1,x,y]</span></span>
|
||||
<span class="lineno"> 64 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">rotate a = fromList [cos r,sin r,-sin r,cos r,0,0]</span></span>
|
||||
<span class="lineno"> 65 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">where r = a * pi / 180</span></span></span>
|
||||
<span class="lineno"> 66 </span>
|
||||
<span class="lineno"> 67 </span>-- | Convert a transformation matrix back into an SVG transformation.
|
||||
<span class="lineno"> 68 </span>toTransformation :: TMatrix -> Transformation
|
||||
<span class="lineno"> 69 </span><span class="decl"><span class="nottickedoff">toTransformation m = TransformMatrix a b c d e f</span>
|
||||
<span class="lineno"> 70 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
||||
<span class="lineno"> 71 </span><span class="spaces"> </span><span class="nottickedoff">[a,c,e,b,d,f,_,_,_] = M.toList m</span></span>
|
||||
|
||||
</pre>
|
||||
</body>
|
||||
|
|
|
|||
Loading…
Reference in a new issue