From 103dbe49f36a55444d08046bdab3c814a7e51d37 Mon Sep 17 00:00:00 2001 From: Lemmih Date: Thu, 27 Aug 2020 15:32:19 +0000 Subject: [PATCH] =?UTF-8?q?Deploying=20to=20gh-pages=20from=20=20@=20f93b6?= =?UTF-8?q?d9a5a1a08e215d3a0009e630ce005371039=20=F0=9F=9A=80?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- hpc_index.html | 78 +- hpc_index_alt.html | 78 +- hpc_index_exp.html | 78 +- hpc_index_fun.html | 78 +- playground/snippets.js | 2 +- .../Geom2D.CubicBezier.Linear.hs.html | 367 +++++ .../Paths_reanimate.hs.html | 73 + .../Reanimate.Animation.hs.html | 417 ++++++ .../Reanimate.Builtin.Documentation.hs.html | 86 ++ .../Reanimate.Builtin.Images.hs.html | 91 ++ .../Reanimate.Builtin.Slide.hs.html | 60 + .../Reanimate.Cache.hs.html | 134 ++ .../Reanimate.ColorComponents.hs.html | 152 +++ .../Reanimate.ColorMap.hs.html | 533 ++++++++ .../Reanimate.Constants.hs.html | 74 + .../Reanimate.Driver.CLI.hs.html | 246 ++++ .../Reanimate.Driver.Check.hs.html | 229 ++++ .../Reanimate.Driver.Compile.hs.html | 58 + .../Reanimate.Driver.Magick.hs.html | 41 + .../Reanimate.Driver.Server.hs.html | 321 +++++ .../Reanimate.Driver.hs.html | 246 ++++ .../Reanimate.Ease.hs.html | 131 ++ .../Reanimate.Effect.hs.html | 154 +++ .../Reanimate.LaTeX.hs.html | 205 +++ .../Reanimate.Math.Common.hs.html | 243 ++++ .../Reanimate.Math.Polygon.hs.html | 824 +++++++++++ .../Reanimate.Math.SSSP.hs.html | 366 +++++ .../Reanimate.Math.Triangulate.hs.html | 108 ++ .../Reanimate.Misc.hs.html | 131 ++ .../Reanimate.Morph.Cache.hs.html | 66 + .../Reanimate.Morph.Common.hs.html | 241 ++++ .../Reanimate.Morph.Linear.hs.html | 114 ++ .../Reanimate.Parameters.hs.html | 145 ++ .../Reanimate.PolyShape.hs.html | 483 +++++++ .../Reanimate.Raster.hs.html | 338 +++++ .../Reanimate.Render.hs.html | 437 ++++++ .../Reanimate.Scene.hs.html | 1203 +++++++++++++++++ .../Reanimate.Svg.BoundingBox.hs.html | 153 +++ .../Reanimate.Svg.Constructors.hs.html | 444 ++++++ .../Reanimate.Svg.LineCommand.hs.html | 302 +++++ .../Reanimate.Svg.Unuse.hs.html | 93 ++ .../Reanimate.Svg.hs.html | 371 +++++ .../Reanimate.Transform.hs.html | 92 ++ .../Reanimate.Transition.hs.html | 99 ++ 44 files changed, 10028 insertions(+), 157 deletions(-) create mode 100644 reanimate-0.4.2.0-inplace/Geom2D.CubicBezier.Linear.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Paths_reanimate.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Animation.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Builtin.Documentation.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Builtin.Images.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Builtin.Slide.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Cache.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.ColorComponents.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.ColorMap.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Constants.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Driver.CLI.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Driver.Check.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Driver.Compile.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Driver.Magick.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Driver.Server.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Driver.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Ease.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Effect.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.LaTeX.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Math.Common.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Math.Polygon.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Math.SSSP.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Math.Triangulate.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Misc.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Morph.Cache.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Morph.Common.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Morph.Linear.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Parameters.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.PolyShape.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Raster.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Render.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Scene.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Svg.BoundingBox.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Svg.Constructors.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Svg.LineCommand.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Svg.Unuse.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Svg.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Transform.hs.html create mode 100644 reanimate-0.4.2.0-inplace/Reanimate.Transition.hs.html diff --git a/hpc_index.html b/hpc_index.html index 2ff4285..beca84b 100644 --- a/hpc_index.html +++ b/hpc_index.html @@ -7,121 +7,121 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + diff --git a/hpc_index_alt.html b/hpc_index_alt.html index abacd8c..5a491da 100644 --- a/hpc_index_alt.html +++ b/hpc_index_alt.html @@ -7,121 +7,121 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
  module reanimate-0.4.1.0-inplace/Geom2D.CubicBezier.Linear  module reanimate-0.4.2.0-inplace/Geom2D.CubicBezier.Linear 20%20/99
5%2/36
28%102/356
  module reanimate-0.4.1.0-inplace/Paths_reanimate  module reanimate-0.4.2.0-inplace/Paths_reanimate 20%3/15
- 0/0 20%12/58
  module reanimate-0.4.1.0-inplace/Reanimate.Animation  module reanimate-0.4.2.0-inplace/Reanimate.Animation 90%28/31
57%8/14
87%298/341
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation  module reanimate-0.4.2.0-inplace/Reanimate.Builtin.Documentation 100%6/6
- 0/0 100%117/117
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Images  module reanimate-0.4.2.0-inplace/Reanimate.Builtin.Images 57%4/7
25%1/4
48%24/49
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Slide  module reanimate-0.4.2.0-inplace/Reanimate.Builtin.Slide 100%3/3
- 0/0 90%54/60
  module reanimate-0.4.1.0-inplace/Reanimate.Cache  module reanimate-0.4.2.0-inplace/Reanimate.Cache 0%0/8
0%0/12
0%0/160
  module reanimate-0.4.1.0-inplace/Reanimate.ColorComponents  module reanimate-0.4.2.0-inplace/Reanimate.ColorComponents 75%9/12
50%1/2
81%135/166
  module reanimate-0.4.1.0-inplace/Reanimate.ColorMap  module reanimate-0.4.2.0-inplace/Reanimate.ColorMap 100%14/14
60%3/5
99%1176/1180
  module reanimate-0.4.1.0-inplace/Reanimate.Constants  module reanimate-0.4.2.0-inplace/Reanimate.Constants 37%3/8
- 0/0 16%3/18
  module reanimate-0.4.1.0-inplace/Reanimate.Driver  module reanimate-0.4.2.0-inplace/Reanimate.Driver 8%1/12
1%1/55
3%9/246
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.CLI  module reanimate-0.4.2.0-inplace/Reanimate.Driver.CLI 14%5/35
0%0/63
8%31/376
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Check  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Check 0%0/21
0%0/27
0%0/396
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Compile  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Compile 0%0/2
0%0/4
0%0/64
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Magick  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Magick 0%0/1
- 0/0 0%0/12
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Server  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Server 0%0/16
0%0/30
0%0/634
  module reanimate-0.4.1.0-inplace/Reanimate.Ease  module reanimate-0.4.2.0-inplace/Reanimate.Ease 87%7/8
100%4/4
96%85/88
  module reanimate-0.4.1.0-inplace/Reanimate.Effect  module reanimate-0.4.2.0-inplace/Reanimate.Effect 52%9/17
66%4/6
53%67/125
  module reanimate-0.4.1.0-inplace/Reanimate.LaTeX  module reanimate-0.4.2.0-inplace/Reanimate.LaTeX 33%4/12
11%1/9
7%12/167
  module reanimate-0.4.1.0-inplace/Reanimate.Math.Common  module reanimate-0.4.2.0-inplace/Reanimate.Math.Common 0%0/26
0%0/12
0%0/407
  module reanimate-0.4.1.0-inplace/Reanimate.Math.Polygon  module reanimate-0.4.2.0-inplace/Reanimate.Math.Polygon 8%7/82
5%4/79
2%58/2494
  module reanimate-0.4.1.0-inplace/Reanimate.Math.SSSP  module reanimate-0.4.2.0-inplace/Reanimate.Math.SSSP 0%0/16
0%0/43
0%0/854
  module reanimate-0.4.1.0-inplace/Reanimate.Math.Triangulate  module reanimate-0.4.2.0-inplace/Reanimate.Math.Triangulate 0%0/5
- 0/0 0%0/139
  module reanimate-0.4.1.0-inplace/Reanimate.Misc  module reanimate-0.4.2.0-inplace/Reanimate.Misc 0%0/7
0%0/14
0%0/162
  module reanimate-0.4.1.0-inplace/Reanimate.Morph.Cache  module reanimate-0.4.2.0-inplace/Reanimate.Morph.Cache 0%0/1
0%0/4
0%0/61
  module reanimate-0.4.1.0-inplace/Reanimate.Morph.Common  module reanimate-0.4.2.0-inplace/Reanimate.Morph.Common 33%5/15
5%1/20
40%133/325
  module reanimate-0.4.1.0-inplace/Reanimate.Morph.Linear  module reanimate-0.4.2.0-inplace/Reanimate.Morph.Linear 40%2/5
16%1/6
26%22/83
  module reanimate-0.4.1.0-inplace/Reanimate.Parameters  module reanimate-0.4.2.0-inplace/Reanimate.Parameters 15%3/20
- 0/0 14%7/49
  module reanimate-0.4.1.0-inplace/Reanimate.PolyShape  module reanimate-0.4.2.0-inplace/Reanimate.PolyShape 22%8/35
27%13/48
18%127/691
  module reanimate-0.4.1.0-inplace/Reanimate.Raster  module reanimate-0.4.2.0-inplace/Reanimate.Raster 15%2/13
0%0/17
11%52/443
  module reanimate-0.4.1.0-inplace/Reanimate.Render  module reanimate-0.4.2.0-inplace/Reanimate.Render 5%1/19
0%0/50
4%39/826
  module reanimate-0.4.1.0-inplace/Reanimate.Scene  module reanimate-0.4.2.0-inplace/Reanimate.Scene 30%40/130
60%15/25
36%545/1483
  module reanimate-0.4.1.0-inplace/Reanimate.Svg  module reanimate-0.4.2.0-inplace/Reanimate.Svg 38%5/13
18%15/80
41%323/777
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.BoundingBox  module reanimate-0.4.2.0-inplace/Reanimate.Svg.BoundingBox 40%2/5
16%6/36
26%76/282
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Constructors  module reanimate-0.4.2.0-inplace/Reanimate.Svg.Constructors 67%33/49
37%3/8
65%369/565
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.LineCommand  module reanimate-0.4.2.0-inplace/Reanimate.Svg.LineCommand 80%12/15
58%43/74
70%659/937
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Unuse  module reanimate-0.4.2.0-inplace/Reanimate.Svg.Unuse 33%1/3
0%0/14
21%28/128
  module reanimate-0.4.1.0-inplace/Reanimate.Transform  module reanimate-0.4.2.0-inplace/Reanimate.Transform 83%5/6
33%4/12
45%76/166
  module reanimate-0.4.1.0-inplace/Reanimate.Transition  module reanimate-0.4.2.0-inplace/Reanimate.Transition 100%6/6
50%1/2
95%43/45
  Program Coverage Total
- + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + diff --git a/hpc_index_exp.html b/hpc_index_exp.html index 68d2ffd..eb62d04 100644 --- a/hpc_index_exp.html +++ b/hpc_index_exp.html @@ -7,121 +7,121 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
  module reanimate-0.4.1.0-inplace/Reanimate.Ease  module reanimate-0.4.2.0-inplace/Reanimate.Ease 87%7/8
100%4/4
96%85/88
  module reanimate-0.4.1.0-inplace/Reanimate.Effect  module reanimate-0.4.2.0-inplace/Reanimate.Effect 52%9/17
66%4/6
53%67/125
  module reanimate-0.4.1.0-inplace/Reanimate.ColorMap  module reanimate-0.4.2.0-inplace/Reanimate.ColorMap 100%14/14
60%3/5
99%1176/1180
  module reanimate-0.4.1.0-inplace/Reanimate.Scene  module reanimate-0.4.2.0-inplace/Reanimate.Scene 30%40/130
60%15/25
36%545/1483
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.LineCommand  module reanimate-0.4.2.0-inplace/Reanimate.Svg.LineCommand 80%12/15
58%43/74
70%659/937
  module reanimate-0.4.1.0-inplace/Reanimate.Animation  module reanimate-0.4.2.0-inplace/Reanimate.Animation 90%28/31
57%8/14
87%298/341
  module reanimate-0.4.1.0-inplace/Reanimate.ColorComponents  module reanimate-0.4.2.0-inplace/Reanimate.ColorComponents 75%9/12
50%1/2
81%135/166
  module reanimate-0.4.1.0-inplace/Reanimate.Transition  module reanimate-0.4.2.0-inplace/Reanimate.Transition 100%6/6
50%1/2
95%43/45
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Constructors  module reanimate-0.4.2.0-inplace/Reanimate.Svg.Constructors 67%33/49
37%3/8
65%369/565
  module reanimate-0.4.1.0-inplace/Reanimate.Transform  module reanimate-0.4.2.0-inplace/Reanimate.Transform 83%5/6
33%4/12
45%76/166
  module reanimate-0.4.1.0-inplace/Reanimate.PolyShape  module reanimate-0.4.2.0-inplace/Reanimate.PolyShape 22%8/35
27%13/48
18%127/691
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Images  module reanimate-0.4.2.0-inplace/Reanimate.Builtin.Images 57%4/7
25%1/4
48%24/49
  module reanimate-0.4.1.0-inplace/Reanimate.Svg  module reanimate-0.4.2.0-inplace/Reanimate.Svg 38%5/13
18%15/80
41%323/777
  module reanimate-0.4.1.0-inplace/Reanimate.Morph.Linear  module reanimate-0.4.2.0-inplace/Reanimate.Morph.Linear 40%2/5
16%1/6
26%22/83
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.BoundingBox  module reanimate-0.4.2.0-inplace/Reanimate.Svg.BoundingBox 40%2/5
16%6/36
26%76/282
  module reanimate-0.4.1.0-inplace/Reanimate.LaTeX  module reanimate-0.4.2.0-inplace/Reanimate.LaTeX 33%4/12
11%1/9
7%12/167
  module reanimate-0.4.1.0-inplace/Geom2D.CubicBezier.Linear  module reanimate-0.4.2.0-inplace/Geom2D.CubicBezier.Linear 20%20/99
5%2/36
28%102/356
  module reanimate-0.4.1.0-inplace/Reanimate.Math.Polygon  module reanimate-0.4.2.0-inplace/Reanimate.Math.Polygon 8%7/82
5%4/79
2%58/2494
  module reanimate-0.4.1.0-inplace/Reanimate.Morph.Common  module reanimate-0.4.2.0-inplace/Reanimate.Morph.Common 33%5/15
5%1/20
40%133/325
  module reanimate-0.4.1.0-inplace/Reanimate.Driver  module reanimate-0.4.2.0-inplace/Reanimate.Driver 8%1/12
1%1/55
3%9/246
  module reanimate-0.4.1.0-inplace/Reanimate.Cache  module reanimate-0.4.2.0-inplace/Reanimate.Cache 0%0/8
0%0/12
0%0/160
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.CLI  module reanimate-0.4.2.0-inplace/Reanimate.Driver.CLI 14%5/35
0%0/63
8%31/376
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Check  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Check 0%0/21
0%0/27
0%0/396
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Compile  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Compile 0%0/2
0%0/4
0%0/64
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Server  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Server 0%0/16
0%0/30
0%0/634
  module reanimate-0.4.1.0-inplace/Reanimate.Math.Common  module reanimate-0.4.2.0-inplace/Reanimate.Math.Common 0%0/26
0%0/12
0%0/407
  module reanimate-0.4.1.0-inplace/Reanimate.Math.SSSP  module reanimate-0.4.2.0-inplace/Reanimate.Math.SSSP 0%0/16
0%0/43
0%0/854
  module reanimate-0.4.1.0-inplace/Reanimate.Misc  module reanimate-0.4.2.0-inplace/Reanimate.Misc 0%0/7
0%0/14
0%0/162
  module reanimate-0.4.1.0-inplace/Reanimate.Morph.Cache  module reanimate-0.4.2.0-inplace/Reanimate.Morph.Cache 0%0/1
0%0/4
0%0/61
  module reanimate-0.4.1.0-inplace/Reanimate.Raster  module reanimate-0.4.2.0-inplace/Reanimate.Raster 15%2/13
0%0/17
11%52/443
  module reanimate-0.4.1.0-inplace/Reanimate.Render  module reanimate-0.4.2.0-inplace/Reanimate.Render 5%1/19
0%0/50
4%39/826
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Unuse  module reanimate-0.4.2.0-inplace/Reanimate.Svg.Unuse 33%1/3
0%0/14
21%28/128
  module reanimate-0.4.1.0-inplace/Paths_reanimate  module reanimate-0.4.2.0-inplace/Paths_reanimate 20%3/15
- 0/0 20%12/58
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation  module reanimate-0.4.2.0-inplace/Reanimate.Builtin.Documentation 100%6/6
- 0/0 100%117/117
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Slide  module reanimate-0.4.2.0-inplace/Reanimate.Builtin.Slide 100%3/3
- 0/0 90%54/60
  module reanimate-0.4.1.0-inplace/Reanimate.Constants  module reanimate-0.4.2.0-inplace/Reanimate.Constants 37%3/8
- 0/0 16%3/18
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Magick  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Magick 0%0/1
- 0/0 0%0/12
  module reanimate-0.4.1.0-inplace/Reanimate.Math.Triangulate  module reanimate-0.4.2.0-inplace/Reanimate.Math.Triangulate 0%0/5
- 0/0 0%0/139
  module reanimate-0.4.1.0-inplace/Reanimate.Parameters  module reanimate-0.4.2.0-inplace/Reanimate.Parameters 15%3/20
- 0/0 14%7/49
  Program Coverage Total
- + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + diff --git a/hpc_index_fun.html b/hpc_index_fun.html index 31f0016..e515911 100644 --- a/hpc_index_fun.html +++ b/hpc_index_fun.html @@ -7,121 +7,121 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation  module reanimate-0.4.2.0-inplace/Reanimate.Builtin.Documentation 100%6/6
- 0/0 100%117/117
  module reanimate-0.4.1.0-inplace/Reanimate.ColorMap  module reanimate-0.4.2.0-inplace/Reanimate.ColorMap 100%14/14
60%3/5
99%1176/1180
  module reanimate-0.4.1.0-inplace/Reanimate.Ease  module reanimate-0.4.2.0-inplace/Reanimate.Ease 87%7/8
100%4/4
96%85/88
  module reanimate-0.4.1.0-inplace/Reanimate.Transition  module reanimate-0.4.2.0-inplace/Reanimate.Transition 100%6/6
50%1/2
95%43/45
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Slide  module reanimate-0.4.2.0-inplace/Reanimate.Builtin.Slide 100%3/3
- 0/0 90%54/60
  module reanimate-0.4.1.0-inplace/Reanimate.Animation  module reanimate-0.4.2.0-inplace/Reanimate.Animation 90%28/31
57%8/14
87%298/341
  module reanimate-0.4.1.0-inplace/Reanimate.ColorComponents  module reanimate-0.4.2.0-inplace/Reanimate.ColorComponents 75%9/12
50%1/2
81%135/166
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.LineCommand  module reanimate-0.4.2.0-inplace/Reanimate.Svg.LineCommand 80%12/15
58%43/74
70%659/937
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Constructors  module reanimate-0.4.2.0-inplace/Reanimate.Svg.Constructors 67%33/49
37%3/8
65%369/565
  module reanimate-0.4.1.0-inplace/Reanimate.Effect  module reanimate-0.4.2.0-inplace/Reanimate.Effect 52%9/17
66%4/6
53%67/125
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Images  module reanimate-0.4.2.0-inplace/Reanimate.Builtin.Images 57%4/7
25%1/4
48%24/49
  module reanimate-0.4.1.0-inplace/Reanimate.Transform  module reanimate-0.4.2.0-inplace/Reanimate.Transform 83%5/6
33%4/12
45%76/166
  module reanimate-0.4.1.0-inplace/Reanimate.Svg  module reanimate-0.4.2.0-inplace/Reanimate.Svg 38%5/13
18%15/80
41%323/777
  module reanimate-0.4.1.0-inplace/Reanimate.Morph.Common  module reanimate-0.4.2.0-inplace/Reanimate.Morph.Common 33%5/15
5%1/20
40%133/325
  module reanimate-0.4.1.0-inplace/Reanimate.Scene  module reanimate-0.4.2.0-inplace/Reanimate.Scene 30%40/130
60%15/25
36%545/1483
  module reanimate-0.4.1.0-inplace/Geom2D.CubicBezier.Linear  module reanimate-0.4.2.0-inplace/Geom2D.CubicBezier.Linear 20%20/99
5%2/36
28%102/356
  module reanimate-0.4.1.0-inplace/Reanimate.Morph.Linear  module reanimate-0.4.2.0-inplace/Reanimate.Morph.Linear 40%2/5
16%1/6
26%22/83
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.BoundingBox  module reanimate-0.4.2.0-inplace/Reanimate.Svg.BoundingBox 40%2/5
16%6/36
26%76/282
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Unuse  module reanimate-0.4.2.0-inplace/Reanimate.Svg.Unuse 33%1/3
0%0/14
21%28/128
  module reanimate-0.4.1.0-inplace/Paths_reanimate  module reanimate-0.4.2.0-inplace/Paths_reanimate 20%3/15
- 0/0 20%12/58
  module reanimate-0.4.1.0-inplace/Reanimate.PolyShape  module reanimate-0.4.2.0-inplace/Reanimate.PolyShape 22%8/35
27%13/48
18%127/691
  module reanimate-0.4.1.0-inplace/Reanimate.Constants  module reanimate-0.4.2.0-inplace/Reanimate.Constants 37%3/8
- 0/0 16%3/18
  module reanimate-0.4.1.0-inplace/Reanimate.Parameters  module reanimate-0.4.2.0-inplace/Reanimate.Parameters 15%3/20
- 0/0 14%7/49
  module reanimate-0.4.1.0-inplace/Reanimate.Raster  module reanimate-0.4.2.0-inplace/Reanimate.Raster 15%2/13
0%0/17
11%52/443
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.CLI  module reanimate-0.4.2.0-inplace/Reanimate.Driver.CLI 14%5/35
0%0/63
8%31/376
  module reanimate-0.4.1.0-inplace/Reanimate.LaTeX  module reanimate-0.4.2.0-inplace/Reanimate.LaTeX 33%4/12
11%1/9
7%12/167
  module reanimate-0.4.1.0-inplace/Reanimate.Render  module reanimate-0.4.2.0-inplace/Reanimate.Render 5%1/19
0%0/50
4%39/826
  module reanimate-0.4.1.0-inplace/Reanimate.Driver  module reanimate-0.4.2.0-inplace/Reanimate.Driver 8%1/12
1%1/55
3%9/246
  module reanimate-0.4.1.0-inplace/Reanimate.Math.Polygon  module reanimate-0.4.2.0-inplace/Reanimate.Math.Polygon 8%7/82
5%4/79
2%58/2494
  module reanimate-0.4.1.0-inplace/Reanimate.Cache  module reanimate-0.4.2.0-inplace/Reanimate.Cache 0%0/8
0%0/12
0%0/160
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Check  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Check 0%0/21
0%0/27
0%0/396
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Compile  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Compile 0%0/2
0%0/4
0%0/64
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Magick  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Magick 0%0/1
- 0/0 0%0/12
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Server  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Server 0%0/16
0%0/30
0%0/634
  module reanimate-0.4.1.0-inplace/Reanimate.Math.Common  module reanimate-0.4.2.0-inplace/Reanimate.Math.Common 0%0/26
0%0/12
0%0/407
  module reanimate-0.4.1.0-inplace/Reanimate.Math.SSSP  module reanimate-0.4.2.0-inplace/Reanimate.Math.SSSP 0%0/16
0%0/43
0%0/854
  module reanimate-0.4.1.0-inplace/Reanimate.Math.Triangulate  module reanimate-0.4.2.0-inplace/Reanimate.Math.Triangulate 0%0/5
- 0/0 0%0/139
  module reanimate-0.4.1.0-inplace/Reanimate.Misc  module reanimate-0.4.2.0-inplace/Reanimate.Misc 0%0/7
0%0/14
0%0/162
  module reanimate-0.4.1.0-inplace/Reanimate.Morph.Cache  module reanimate-0.4.2.0-inplace/Reanimate.Morph.Cache 0%0/1
0%0/4
0%0/61
  Program Coverage Total
- + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + diff --git a/playground/snippets.js b/playground/snippets.js index 487e47f..02112bf 100644 --- a/playground/snippets.js +++ b/playground/snippets.js @@ -9,4 +9,4 @@ const snippets = [{"title": "Hello World","url": "https://reanimate.clozecards.c ,{"title": "Object Positions","url": "https://reanimate.clozecards.com/PHaVM0ar3yF/195.svg","code": "env =\n addStatic (mkBackground \"white\") .\n mapA (withStrokeColor \"black\")\n\nanimation :: Animation\nanimation = env $\n sceneAnimation $ do\n -- Configure objects\n txt <- newText \"Center\"\n top <- newText \"Top\"\n oModifyS top $ \n oTopY .= screenTop\n topR <- newText \"Top right\"\n oModifyS topR $ do\n oTopY .= screenTop\n oRightX .= screenRight\n botR <- newText \"Bottom right\"\n oModifyS botR $ do\n oTranslate .= (0, screenBottom+0.5)\n oRightX .= screenRight\n botL <- newText \"Bottom left\"\n oModifyS botL $ do\n oTranslate .= (0, screenBottom+0.5)\n oLeftX .= screenLeft\n topL <- newText \"Top left\"\n oModifyS topL $ do\n oTopY .= screenTop\n oLeftX .= screenLeft\n -- Show objects\n oShow txt\n wait 1\n switchTo txt top\n switchTo top topR\n switchTo topR botR\n switchTo botR botL\n switchTo botL topL\n switchTo topL txt\n\nswitchTo src dst = do\n fork $ oFadeOut src 1\n oModify dst $ oOpacity .~ 1\n oFadeIn dst 1\n wait 1\n\nnewText txt =\n newObject $ scale 1.5 $ center $ latex txt\n"} ,{"title": "Camera","url": "https://reanimate.clozecards.com/CD5Bg7AwVkF/150.svg","code": "animation :: Animation\nanimation = docEnv $ mapA (withFillOpacity 1) $ sceneAnimation $ do\n cam <- newObject Camera\n\n txt <- newObject $ center $ latex \"Fixed (non-cam)\"\n oModifyS txt $ do\n oTopY .= screenTop \n oZIndex .= 2\n\n circle <- newObject $ Circle 1\n cameraAttach cam circle\n oModify circle $ oContext .~ withFillColor \"blue\"\n circleRight <- oRead circle oRightX\n\n box <- newObject $ Rectangle 2 2\n cameraAttach cam box\n oModify box $ oContext .~ withFillColor \"green\"\n oModify box $ oLeftX .~ circleRight\n boxCenter <- oRead box oCenterXY\n\n small <- newObject $ center $ latex \"This text is very small\"\n cameraAttach cam small\n oModifyS small $ do\n oCenterXY .= boxCenter\n oScale .= 0.1\n \n oShow txt\n oShow small\n oShow circle\n oShow box\n\n wait 1\n\n cameraFocus cam boxCenter\n waitOn $ do\n fork $ cameraPan cam 3 boxCenter\n fork $ cameraZoom cam 3 15\n \n wait 2\n cameraZoom cam 3 1\n cameraPan cam 1 (0,0)\n"} ]; -const playgroundVersion = "2020-08-27 (d6523)"; +const playgroundVersion = "2020-08-27 (f93b6)"; diff --git a/reanimate-0.4.2.0-inplace/Geom2D.CubicBezier.Linear.hs.html b/reanimate-0.4.2.0-inplace/Geom2D.CubicBezier.Linear.hs.html new file mode 100644 index 0000000..8f8d0a4 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Geom2D.CubicBezier.Linear.hs.html @@ -0,0 +1,367 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE DeriveFoldable         #-}
+    2 {-# LANGUAGE DeriveFunctor          #-}
+    3 {-# LANGUAGE DeriveTraversable      #-}
+    4 {-# LANGUAGE FunctionalDependencies #-}
+    5 {-# LANGUAGE MultiParamTypeClasses  #-}
+    6 {-# LANGUAGE UndecidableInstances   #-}
+    7 {-|
+    8 Module      : Geom2D.CubicBezier.Linear
+    9 Copyright   : Written by David Himmelstrup
+   10 License     : Unlicense
+   11 Maintainer  : lemmih@gmail.com
+   12 Stability   : experimental
+   13 Portability : POSIX
+   14 
+   15 Convenience wrapper around 'Geom2D.CubicBezier'
+   16 
+   17 -}
+   18 module Geom2D.CubicBezier.Linear
+   19   ( AnyBezier(..)
+   20   , CubicBezier(..)
+   21   , QuadBezier(..)
+   22   , OpenPath(..)
+   23   , ClosedPath(..)
+   24   , PathJoin(..)
+   25   , ClosedMetaPath(..)
+   26   , OpenMetaPath(..)
+   27   , MetaJoin(..)
+   28   , MetaNodeType(..)
+   29   , FillRule(..)
+   30   , Tension(..)
+   31   , quadToCubic
+   32   , arcLength
+   33   , arcLengthParam
+   34   , C.splitBezier
+   35   , colinear
+   36   , evalBezier
+   37   , evalBezierDeriv
+   38   , bezierHoriz
+   39   , bezierVert
+   40   , C.bezierSubsegment
+   41   , C.reorient
+   42   , closedPathCurves
+   43   , openPathCurves
+   44   , curvesToClosed
+   45   , closest
+   46   , unmetaOpen
+   47   , unmetaClosed
+   48   , union
+   49   , bezierIntersection
+   50   , interpolateVector
+   51   , vectorDistance
+   52   , findBezierInflection
+   53   , findBezierCusp
+   54   ) where
+   55 
+   56 import qualified Data.Vector.Unboxed as V
+   57 import qualified Geom2D.CubicBezier  as C
+   58 import           Graphics.SvgTree    (FillRule (..))
+   59 import           Linear.V2
+   60 
+   61 ------------------------------------------------------------
+   62 -- Data types
+   63 
+   64 -- | A bezier curve of any degree.
+   65 newtype AnyBezier a = AnyBezier (V.Vector (V2 a))
+   66 
+   67 -- | A cubic bezier curve.
+   68 data CubicBezier a = CubicBezier
+   69   { cubicC0 :: !(V2 a)
+   70   , cubicC1 :: !(V2 a)
+   71   , cubicC2 :: !(V2 a)
+   72   , cubicC3 :: !(V2 a)
+   73   } deriving (Show, Eq)
+   74 
+   75 -- | A quadratic bezier curve.
+   76 data QuadBezier a = QuadBezier
+   77   { quadC0 :: !(V2 a)
+   78   , quadC1 :: !(V2 a)
+   79   , quadC2 :: !(V2 a)
+   80   } deriving (Show, Eq)
+   81 
+   82 -- | Open cubicbezier path.
+   83 data OpenPath a = OpenPath [(V2 a, PathJoin a)] (V2 a)
+   84   deriving (Show, Eq)
+   85 
+   86 -- | Closed cubicbezier path.
+   87 data ClosedPath a = ClosedPath [(V2 a, PathJoin a)]
+   88   deriving (Show, Eq)
+   89 
+   90 -- | Join two points with either a straight line or a bezier
+   91 --   curve with two control points.
+   92 data PathJoin a
+   93   = JoinLine
+   94   | JoinCurve (V2 a) (V2 a)
+   95   deriving (Show, Eq)
+   96 
+   97 -- | Closed meta path.
+   98 data ClosedMetaPath a = ClosedMetaPath [(V2 a, MetaJoin a)]
+   99   deriving (Show, Eq)
+  100 
+  101 -- | Open meta path
+  102 data OpenMetaPath a = OpenMetaPath [(V2 a, MetaJoin a)] (V2 a)
+  103   deriving (Show, Eq)
+  104 
+  105 -- | The tension value specifies how /tense/ the curve is.
+  106 --   A higher value means the curve approaches a line segment,
+  107 --   while a lower value means the curve is more round. Metafont
+  108 --   doesn't allow values below 3/4.
+  109 data Tension a
+  110   = Tension
+  111   { tensionValue :: a }
+  112   | TensionAtLeast -- ^ Like Tension, but keep the segment inside the
+  113                    --   bounding triangle defined by the control points,
+  114                    --   if there is one.
+  115   { tensionValue :: a }
+  116   deriving (Functor, Foldable, Traversable, Eq, Show)
+  117 
+  118 -- | Join two meta points with either a bezier curve or tension
+  119 --   contraints.
+  120 data MetaJoin a
+  121   = MetaJoin
+  122   { metaTypeL :: MetaNodeType a
+  123   , tensionL  :: Tension a
+  124   , tensionR  :: Tension a
+  125   , metaTypeR :: MetaNodeType a
+  126   }
+  127   | Controls (V2 a) (V2 a)
+  128   deriving (Show, Eq)
+  129 
+  130 -- | Node constraint type.
+  131 data MetaNodeType a
+  132   = Open
+  133   | Curl { curlgamma :: a }
+  134   | Direction { nodedir :: V2 a }
+  135   deriving (Show, Eq)
+  136 
+  137 ------------------------------------------------------------
+  138 -- Methods
+  139 
+  140 -- | Convert a quadratic bezier to a cubic bezier.
+  141 quadToCubic :: Fractional a => QuadBezier a -> CubicBezier a
+  142 quadToCubic = upCast . C.quadToCubic . downCast
+  143 
+  144 -- | @arcLength c t tol@ finds the arclength of the bezier @c@ at @t@,
+  145 --   within given tolerance @tol@.
+  146 arcLength :: CubicBezier Double -> Double -> Double -> Double
+  147 arcLength bezier t tol = C.arcLength (downCast bezier) t tol
+  148 
+  149 -- | @arcLengthParam c len tol@ finds the parameter where the curve @c@
+  150 --   has the arclength @len@, within tolerance @tol@.
+  151 arcLengthParam :: CubicBezier Double -> Double -> Double -> Double
+  152 arcLengthParam bezier t tol = C.arcLengthParam (downCast bezier) t tol
+  153 
+  154 -- | Return @False@ if some points fall outside a line with a thickness of the given tolerance.
+  155 colinear :: CubicBezier Double -> Double -> Bool
+  156 colinear bezier tol = C.colinear (downCast bezier) tol
+  157 
+  158 -- | Calculate a value on the bezier curve.
+  159 evalBezier :: (C.GenericBezier b, V.Unbox a, Fractional a) => b a -> a -> V2 a
+  160 evalBezier c p = upCast $ C.evalBezier c p
+  161 
+  162 -- | Calculate a value and the first derivative on the curve.
+  163 evalBezierDeriv :: (V.Unbox a, Fractional a,C.GenericBezier b) => b a -> a -> (V2 a, V2 a)
+  164 evalBezierDeriv c p = upCast $ C.evalBezierDeriv c p
+  165 
+  166 -- | Find the parameter where the bezier curve is horizontal.
+  167 bezierHoriz :: CubicBezier Double -> [Double]
+  168 bezierHoriz = C.bezierHoriz . downCast
+  169 
+  170 -- | Find the parameter where the bezier curve is vertical.
+  171 bezierVert :: CubicBezier Double -> [Double]
+  172 bezierVert = C.bezierVert . downCast
+  173 
+  174 -- | Create a normal path from a metapath.
+  175 unmetaOpen :: OpenMetaPath Double -> OpenPath Double
+  176 unmetaOpen = upCast . C.unmetaOpen . downCast
+  177 
+  178 -- | Create a normal path from a metapath.
+  179 unmetaClosed :: ClosedMetaPath Double -> ClosedPath Double
+  180 unmetaClosed = upCast . C.unmetaClosed . downCast
+  181 
+  182 -- | `O((n+m)*log(n+m))`, for n segments and m intersections.
+  183 --   Union of paths, removing overlap and rounding to the given tolerance.
+  184 union :: [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
+  185 union p fill tol = upCast (C.union (downCast p) (downCast fill) tol)
+  186 
+  187 -- | Find the intersections between two Bezier curves, using the Bezier Clip algorithm.
+  188 --   Returns the parameters for both curves.
+  189 bezierIntersection :: CubicBezier Double -> CubicBezier Double -> Double -> [(Double, Double)]
+  190 bezierIntersection a b t = C.bezierIntersection (downCast a) (downCast b) t
+  191 
+  192 -- | Find the closest value on the bezier to the given point, within tolerance.
+  193 --   Return the first value found.
+  194 closest :: CubicBezier Double -> V2 Double -> Double -> Double
+  195 closest c p t = C.closest (downCast c) (downCast p) t
+  196 
+  197 -- | Return the closed path as a list of curves.
+  198 closedPathCurves :: Fractional a => ClosedPath a -> [CubicBezier a]
+  199 closedPathCurves = upCast . C.closedPathCurves . downCast
+  200 
+  201 -- | Return the open path as a list of curves.
+  202 openPathCurves :: Fractional a => OpenPath a -> [CubicBezier a]
+  203 openPathCurves = upCast . C.openPathCurves . downCast
+  204 
+  205 -- | Make an open path from a list of curves. The last control point of each curve is ignored.
+  206 curvesToClosed :: [CubicBezier a] -> ClosedPath a
+  207 curvesToClosed = upCast . C.curvesToClosed . downCast
+  208 
+  209 -- | Interpolate between two vectors.
+  210 interpolateVector :: Num a => V2 a -> V2 a -> a -> V2 a
+  211 interpolateVector a b p = upCast $ C.interpolateVector (downCast a) (downCast b) p
+  212 
+  213 -- | Distance between two vectors.
+  214 vectorDistance :: Floating a => V2 a -> V2 a -> a
+  215 vectorDistance a b = C.vectorDistance (downCast a) (downCast b)
+  216 
+  217 -- | Find inflection points on the curve.
+  218 findBezierInflection :: CubicBezier Double -> [Double]
+  219 findBezierInflection = C.findBezierInflection . downCast
+  220 
+  221 -- | Find the cusps of a bezier.
+  222 findBezierCusp :: CubicBezier Double -> [Double]
+  223 findBezierCusp = C.findBezierCusp . downCast
+  224 
+  225 ------------------------------------------------------------
+  226 -- Instances
+  227 
+  228 instance C.GenericBezier QuadBezier where
+  229   degree = C.degree . downCast
+  230   toVector = C.toVector . downCast
+  231   unsafeFromVector = upCast . C.unsafeFromVector
+  232 
+  233 instance C.GenericBezier CubicBezier where
+  234   degree = C.degree . downCast
+  235   toVector = C.toVector . downCast
+  236   unsafeFromVector = upCast . C.unsafeFromVector
+  237 
+  238 instance C.GenericBezier AnyBezier where
+  239   degree = C.degree . downCast
+  240   toVector = C.toVector . downCast
+  241   unsafeFromVector = upCast . C.unsafeFromVector
+  242 
+  243 ------------------------------------------------------------
+  244 -- Casting
+  245 
+  246 class Cast a b | a -> b, b -> a where
+  247   downCast :: a -> b
+  248   upCast   :: b -> a
+  249 
+  250 instance Cast a b => Cast [a] [b] where
+  251   downCast = map downCast
+  252   upCast = map upCast
+  253 
+  254 instance (Cast a a', Cast b b') => Cast (a,b) (a',b') where
+  255   downCast (a, b) = (downCast a, downCast b)
+  256   upCast (a, b) = (upCast a, upCast b)
+  257 
+  258 instance Cast (V2 a) (C.Point a) where
+  259   downCast (V2 a b) = C.Point a b
+  260   upCast (C.Point a b) = V2 a b
+  261 
+  262 instance Cast FillRule C.FillRule where
+  263   downCast FillEvenOdd = C.EvenOdd
+  264   downCast FillNonZero = C.NonZero
+  265   upCast C.EvenOdd = FillEvenOdd
+  266   upCast C.NonZero = FillNonZero
+  267 
+  268 instance Cast (CubicBezier a) (C.CubicBezier a) where
+  269   downCast (CubicBezier a b c d) = C.CubicBezier
+  270     (downCast a) (downCast b) (downCast c) (downCast d)
+  271   upCast (C.CubicBezier a b c d) = CubicBezier
+  272     (upCast a) (upCast b) (upCast c) (upCast d)
+  273 
+  274 instance Cast (QuadBezier a) (C.QuadBezier a) where
+  275   downCast (QuadBezier a b c) = C.QuadBezier
+  276     (downCast a) (downCast b) (downCast c)
+  277   upCast (C.QuadBezier a b c)= QuadBezier
+  278     (upCast a) (upCast b) (upCast c)
+  279 
+  280 instance V.Unbox a => Cast (AnyBezier a) (C.AnyBezier a) where
+  281   downCast (AnyBezier arr) = C.AnyBezier $
+  282     V.map (\(V2 a b) -> (a,b)) arr
+  283   upCast (C.AnyBezier arr) = AnyBezier $
+  284     V.map (\(a, b) -> V2 a b) arr
+  285 
+  286 instance Cast (MetaNodeType a) (C.MetaNodeType a) where
+  287   downCast Open            = C.Open
+  288   downCast (Curl gamma)    = C.Curl gamma
+  289   downCast (Direction dir) = C.Direction (downCast dir)
+  290   upCast C.Open            = Open
+  291   upCast (C.Curl gamma)    = Curl gamma
+  292   upCast (C.Direction dir) = Direction (upCast dir)
+  293 
+  294 instance Cast (Tension a) (C.Tension a) where
+  295   downCast (Tension v)        = C.Tension v
+  296   downCast (TensionAtLeast v) = C.TensionAtLeast v
+  297   upCast (C.Tension v)        = Tension v
+  298   upCast (C.TensionAtLeast v) = TensionAtLeast v
+  299 
+  300 instance Cast (MetaJoin a) (C.MetaJoin a) where
+  301   downCast (MetaJoin tyL tL tR tyR) =
+  302     C.MetaJoin (downCast tyL) (downCast tL) (downCast tR) (downCast tyR)
+  303   downCast (Controls p1 p2) = C.Controls (downCast p1) (downCast p2)
+  304   upCast (C.MetaJoin tyL tL tR tyR) =
+  305     MetaJoin (upCast tyL) (upCast tL) (upCast tR) (upCast tyR)
+  306   upCast (C.Controls p1 p2)         = Controls (upCast p1) (upCast p2)
+  307 
+  308 instance Cast (PathJoin a) (C.PathJoin a) where
+  309   downCast JoinLine        = C.JoinLine
+  310   downCast (JoinCurve a b) = C.JoinCurve (downCast a) (downCast b)
+  311   upCast C.JoinLine        = JoinLine
+  312   upCast (C.JoinCurve a b) = JoinCurve (upCast a) (upCast b)
+  313 
+  314 instance Cast (OpenMetaPath a) (C.OpenMetaPath a) where
+  315   downCast (OpenMetaPath lst end) = C.OpenMetaPath
+  316     [ (downCast p, downCast j)
+  317     | (p, j) <- lst ] (downCast end)
+  318   upCast (C.OpenMetaPath lst end) = OpenMetaPath
+  319     [ (upCast p, upCast j)
+  320     | (p, j) <- lst ] (upCast end)
+  321 
+  322 instance Cast (ClosedMetaPath a) (C.ClosedMetaPath a) where
+  323   downCast (ClosedMetaPath lst) = C.ClosedMetaPath
+  324     [ (downCast p, downCast j)
+  325     | (p, j) <- lst ]
+  326   upCast (C.ClosedMetaPath lst) = ClosedMetaPath
+  327     [ (upCast p, upCast j)
+  328     | (p, j) <- lst ]
+  329 
+  330 instance Cast (OpenPath a) (C.OpenPath a) where
+  331   downCast (OpenPath lst end) = C.OpenPath
+  332     [ (downCast p, downCast j)
+  333     | (p, j) <- lst ] (downCast end)
+  334   upCast (C.OpenPath lst end) = OpenPath
+  335     [ (upCast p, upCast j)
+  336     | (p, j) <- lst ] (upCast end)
+  337 
+  338 instance Cast (ClosedPath a) (C.ClosedPath a) where
+  339   downCast (ClosedPath lst) = C.ClosedPath
+  340     [ (downCast p, downCast j)
+  341     | (p, j) <- lst ]
+  342   upCast (C.ClosedPath lst) = ClosedPath
+  343     [ (upCast p, upCast j)
+  344     | (p, j) <- lst ]
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Paths_reanimate.hs.html b/reanimate-0.4.2.0-inplace/Paths_reanimate.hs.html new file mode 100644 index 0000000..ceb9962 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Paths_reanimate.hs.html @@ -0,0 +1,73 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE CPP #-}
+    2 {-# LANGUAGE NoRebindableSyntax #-}
+    3 {-# OPTIONS_GHC -fno-warn-missing-import-lists #-}
+    4 module Paths_reanimate (
+    5     version,
+    6     getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,
+    7     getDataFileName, getSysconfDir
+    8   ) where
+    9 
+   10 import qualified Control.Exception as Exception
+   11 import Data.Version (Version(..))
+   12 import System.Environment (getEnv)
+   13 import Prelude
+   14 
+   15 #if defined(VERSION_base)
+   16 
+   17 #if MIN_VERSION_base(4,0,0)
+   18 catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
+   19 #else
+   20 catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a
+   21 #endif
+   22 
+   23 #else
+   24 catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
+   25 #endif
+   26 catchIO = Exception.catch
+   27 
+   28 version :: Version
+   29 version = Version [0,4,2,0] []
+   30 bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath
+   31 
+   32 bindir     = "/home/runner/.cabal/bin"
+   33 libdir     = "/home/runner/.cabal/lib/x86_64-linux-ghc-8.8.3/reanimate-0.4.2.0-inplace"
+   34 dynlibdir  = "/home/runner/.cabal/lib/x86_64-linux-ghc-8.8.3"
+   35 datadir    = "/home/runner/.cabal/share/x86_64-linux-ghc-8.8.3/reanimate-0.4.2.0"
+   36 libexecdir = "/home/runner/.cabal/libexec/x86_64-linux-ghc-8.8.3/reanimate-0.4.2.0"
+   37 sysconfdir = "/home/runner/.cabal/etc"
+   38 
+   39 getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath
+   40 getBinDir = catchIO (getEnv "reanimate_bindir") (\_ -> return bindir)
+   41 getLibDir = catchIO (getEnv "reanimate_libdir") (\_ -> return libdir)
+   42 getDynLibDir = catchIO (getEnv "reanimate_dynlibdir") (\_ -> return dynlibdir)
+   43 getDataDir = catchIO (getEnv "reanimate_datadir") (\_ -> return datadir)
+   44 getLibexecDir = catchIO (getEnv "reanimate_libexecdir") (\_ -> return libexecdir)
+   45 getSysconfDir = catchIO (getEnv "reanimate_sysconfdir") (\_ -> return sysconfdir)
+   46 
+   47 getDataFileName :: FilePath -> IO FilePath
+   48 getDataFileName name = do
+   49   dir <- getDataDir
+   50   return (dir ++ "/" ++ name)
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Animation.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Animation.hs.html new file mode 100644 index 0000000..75d0f2c --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Animation.hs.html @@ -0,0 +1,417 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-|
+    2 Module      : Reanimate.Animation
+    3 Copyright   : Written by David Himmelstrup
+    4 License     : Unlicense
+    5 Maintainer  : lemmih@gmail.com
+    6 Stability   : experimental
+    7 Portability : POSIX
+    8 
+    9 Declarative animation API based on combinators. For a higher-level interface,
+   10 see 'Reanimate.Scene'.
+   11 
+   12 -}
+   13 module Reanimate.Animation
+   14   ( Duration
+   15   , Time
+   16   , SVG
+   17   , Animation
+   18   -- * Creating animations
+   19   , mkAnimation
+   20   , animate
+   21   , staticFrame
+   22   , pause
+   23   -- * Querying animations
+   24   , duration
+   25   , frameAt
+   26   -- * Composing animations
+   27   , seqA
+   28   , andThen
+   29   , parA
+   30   , parLoopA
+   31   , parDropA
+   32   -- * Modifying animations
+   33   , setDuration
+   34   , adjustDuration
+   35   , mapA
+   36   , takeA
+   37   , dropA
+   38   , lastA
+   39   , pauseAtEnd
+   40   , pauseAtBeginning
+   41   , pauseAround
+   42   , repeatA
+   43   , reverseA
+   44   , playThenReverseA
+   45   , signalA
+   46   , freezeAtPercentage
+   47   , addStatic
+   48   -- * Misc
+   49   , getAnimationFrame
+   50   , Sync(..)
+   51   -- * Rendering
+   52   , renderTree
+   53   , renderSvg
+   54   ) where
+   55 
+   56 import           Control.Arrow              ()
+   57 import           Data.Fixed                 (mod')
+   58 import           Graphics.SvgTree           (Alignment (..), Document (..),
+   59                                              Number (..),
+   60                                              PreserveAspectRatio (..),
+   61                                              Tree (..), xmlOfTree)
+   62 import           Graphics.SvgTree.Printer
+   63 import           Reanimate.Constants
+   64 import           Reanimate.Ease
+   65 import           Reanimate.Svg.Constructors
+   66 import           Text.XML.Light.Output
+   67 
+   68 -- | Duration of an animation or effect. Usually measured in seconds.
+   69 type Duration = Double
+   70 -- | Time signal. Goes from 0 to 1, inclusive.
+   71 type Time = Double
+   72 
+   73 -- | SVG node.
+   74 type SVG = Tree
+   75 
+   76 -- | Animations are SVGs over a finite time.
+   77 data Animation = Animation Duration (Time -> SVG)
+   78 
+   79 -- | Construct an animation with a given duration.
+   80 mkAnimation :: Duration -> (Time -> SVG) -> Animation
+   81 mkAnimation = Animation
+   82 
+   83 -- | Construct an animation with a duration of @1@.
+   84 animate :: (Time -> SVG) -> Animation
+   85 animate = Animation 1
+   86 
+   87 -- | Create an animation with provided @duration@, which consists of stationary frame displayed for its entire duration.
+   88 staticFrame :: Duration -> SVG -> Animation
+   89 staticFrame d svg = Animation d (const svg)
+   90 
+   91 -- | Query the duration of an animation.
+   92 duration :: Animation -> Duration
+   93 duration (Animation d _) = d
+   94 
+   95 -- | Play animations in sequence. The @lhs@ animation is removed after it has
+   96 --   completed. New animation duration is '@duration lhs + duration rhs@'.
+   97 --
+   98 --   Example:
+   99 --
+  100 --   > drawBox `seqA` drawCircle
+  101 --
+  102 --   <<docs/gifs/doc_seqA.gif>>
+  103 seqA :: Animation -> Animation -> Animation
+  104 seqA (Animation d1 f1) (Animation d2 f2) =
+  105   Animation totalD $ \t ->
+  106     if t < d1/totalD
+  107       then f1 (t * totalD/d1)
+  108       else f2 ((t-d1/totalD) * totalD/d2)
+  109   where
+  110     totalD = d1+d2
+  111 
+  112 -- | Play two animation concurrently. Shortest animation freezes on last frame.
+  113 --   New animation duration is '@max (duration lhs) (duration rhs)@'.
+  114 --
+  115 --   Example:
+  116 --
+  117 --   > drawBox `parA` adjustDuration (*2) drawCircle
+  118 --
+  119 --   <<docs/gifs/doc_parA.gif>>
+  120 parA :: Animation -> Animation -> Animation
+  121 parA (Animation d1 f1) (Animation d2 f2) =
+  122   Animation (max d1 d2) $ \t ->
+  123     let t1 = t * totalD/d1
+  124         t2 = t * totalD/d2 in
+  125     mkGroup
+  126     [ f1 (min 1 t1)
+  127     , f2 (min 1 t2) ]
+  128   where
+  129     totalD = max d1 d2
+  130 
+  131 -- | Play two animation concurrently. Shortest animation loops.
+  132 --   New animation duration is '@max (duration lhs) (duration rhs)@'.
+  133 --
+  134 --   Example:
+  135 --
+  136 --   > drawBox `parLoopA` adjustDuration (*2) drawCircle
+  137 --
+  138 --   <<docs/gifs/doc_parLoopA.gif>>
+  139 parLoopA :: Animation -> Animation -> Animation
+  140 parLoopA (Animation d1 f1) (Animation d2 f2) =
+  141   Animation totalD $ \t ->
+  142     let t1 = t * totalD/d1
+  143         t2 = t * totalD/d2 in
+  144     mkGroup
+  145     [ f1 (t1 `mod'` 1)
+  146     , f2 (t2 `mod'` 1) ]
+  147   where
+  148     totalD = max d1 d2
+  149 
+  150 -- | Play two animation concurrently. Animations disappear after playing once.
+  151 --   New animation duration is '@max (duration lhs) (duration rhs)@'.
+  152 --
+  153 --   Example:
+  154 --
+  155 --   > drawBox `parLoopA` adjustDuration (*2) drawCircle
+  156 --
+  157 --   <<docs/gifs/doc_parDropA.gif>>
+  158 parDropA :: Animation -> Animation -> Animation
+  159 parDropA (Animation d1 f1) (Animation d2 f2) =
+  160   Animation totalD $ \t ->
+  161     let t1 = t * totalD/d1
+  162         t2 = t * totalD/d2 in
+  163     mkGroup
+  164     [ if t1>1 then None else f1 t1
+  165     , if t2>1 then None else f2 t2 ]
+  166   where
+  167     totalD = max d1 d2
+  168 
+  169 -- | Empty animation (no SVG output) with a fixed duration.
+  170 --
+  171 --   Example:
+  172 --
+  173 --   > pause 1 `seqA` drawProgress
+  174 --
+  175 --   <<docs/gifs/doc_pause.gif>>
+  176 pause :: Duration -> Animation
+  177 pause d = Animation d (const None)
+  178 
+  179 -- | Play left animation and freeze on the last frame, then play the right
+  180 --   animation. New duration is '@duration lhs + duration rhs@'.
+  181 --
+  182 --   Example:
+  183 --
+  184 --   > drawBox `andThen` drawCircle
+  185 --
+  186 --   <<docs/gifs/doc_andThen.gif>>
+  187 andThen :: Animation -> Animation -> Animation
+  188 andThen a b = a `parA` (pause (duration a) `seqA` b)
+  189 
+  190 -- | Calculate the frame that would be displayed at given point in @time@ of running @animation@.
+  191 --
+  192 -- The provided time parameter is clamped between 0 and animation duration.
+  193 frameAt :: Time -> Animation -> SVG
+  194 frameAt t (Animation d f) = f t'
+  195   where
+  196     t' = clamp 0 1 (t/d)
+  197 
+  198 -- | Helper function for pretty-printing SVG nodes.
+  199 renderTree :: SVG -> String
+  200 renderTree t = maybe "" ppElement $ xmlOfTree t
+  201 
+  202 -- | Helper function for pretty-printing SVG nodes as SVG documents.
+  203 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.
+  204           -> Maybe Number -- ^ Similar to previous argument, but for @height@ attribute.
+  205           -> SVG          -- ^ SVG to render
+  206           -> String       -- ^ String representation of SVG XML markup
+  207 renderSvg w h t = ppDocument doc
+  208 -- renderSvg w h t = ppFastElement (xmlOfDocument doc)
+  209   where
+  210     width = 16
+  211     height = 9
+  212     doc = Document
+  213       { _viewBox = Just (-width/2, -height/2, width, height)
+  214       , _width = w
+  215       , _height = h
+  216       , _elements = [withStrokeWidth defaultStrokeWidth $ scaleXY 1 (-1) t]
+  217       , _description = ""
+  218       , _documentLocation = ""
+  219       , _documentAspectRatio = PreserveAspectRatio False AlignNone Nothing
+  220       }
+  221 
+  222 -- | Map over the SVG produced by an animation at every frame.
+  223 --
+  224 --   Example:
+  225 --
+  226 --   > mapA (scale 0.5) drawCircle
+  227 --
+  228 --   <<docs/gifs/doc_mapA.gif>>
+  229 
+  230 mapA :: (SVG -> SVG) -> Animation -> Animation
+  231 mapA fn (Animation d f) = Animation d (fn . f)
+  232 
+  233 -- | Freeze the last frame for @t@ seconds at the end of the animation.
+  234 --
+  235 --   Example:
+  236 --
+  237 --   > pauseAtEnd 1 drawProgress
+  238 --
+  239 --   <<docs/gifs/doc_pauseAtEnd.gif>>
+  240 pauseAtEnd :: Duration -> Animation -> Animation
+  241 pauseAtEnd t a = a `andThen` pause t
+  242 
+  243 -- | Freeze the first frame for @t@ seconds at the beginning of the animation.
+  244 --
+  245 --   Example:
+  246 --
+  247 --   > pauseAtBeginning 1 drawProgress
+  248 --
+  249 --   <<docs/gifs/doc_pauseAtBeginning.gif>>
+  250 pauseAtBeginning :: Duration -> Animation -> Animation
+  251 pauseAtBeginning t a =
+  252     Animation t (freezeFrame 0 a) `seqA` a
+  253 
+  254 -- | Freeze the first and the last frame of the animation for a specified duration.
+  255 --
+  256 --   Example:
+  257 --
+  258 --   > pauseAround 1 1 drawProgress
+  259 --
+  260 --   <<docs/gifs/doc_pauseAround.gif>>
+  261 pauseAround :: Duration -> Duration -> Animation -> Animation
+  262 pauseAround start end = pauseAtEnd end . pauseAtBeginning start
+  263 
+  264 -- Freeze frame at time @t@.
+  265 freezeFrame :: Time -> Animation -> (Time -> SVG)
+  266 freezeFrame t (Animation d f) = const $ f (t/d)
+  267 
+  268 -- | Change the duration of an animation. Animates are stretched or squished
+  269 --   (rather than truncated) to fit the new duration.
+  270 adjustDuration :: (Duration -> Duration) -> Animation -> Animation
+  271 adjustDuration fn (Animation d gen) =
+  272   Animation (fn d) gen
+  273 
+  274 -- | Set the duration of an animation by adjusting its playback rate. The
+  275 --   animation is still played from start to finish without being cropped.
+  276 setDuration :: Duration -> Animation -> Animation
+  277 setDuration newD = adjustDuration (const newD)
+  278 
+  279 -- | Play an animation in reverse. Duration remains unchanged. Shorthand for:
+  280 --   @'signalA' 'reverseS'@.
+  281 --
+  282 --   Example:
+  283 --
+  284 --   > reverseA drawCircle
+  285 --
+  286 --   <<docs/gifs/doc_reverseA.gif>>
+  287 reverseA :: Animation -> Animation
+  288 reverseA = signalA reverseS
+  289 
+  290 -- | Play animation before playing it again in reverse. Duration is twice
+  291 --   the duration of the input.
+  292 --
+  293 --   Example:
+  294 --
+  295 --   > playThenReverseA drawCircle
+  296 --
+  297 --   <<docs/gifs/doc_playThenReverseA.gif>>
+  298 playThenReverseA :: Animation -> Animation
+  299 playThenReverseA a = a `seqA` reverseA a
+  300 
+  301 -- | Loop animation @n@ number of times. This number may be fractional and it
+  302 --   may be less than 1. It must be greater than or equal to 0, though.
+  303 --   New duration is @n*duration input@.
+  304 --
+  305 --   Example:
+  306 --
+  307 --   > repeatA 1.5 drawCircle
+  308 --
+  309 --   <<docs/gifs/doc_repeatA.gif>>
+  310 repeatA :: Double -> Animation -> Animation
+  311 repeatA n (Animation d f) = Animation (d*n) $ \t ->
+  312   f ((t*n) `mod'` 1)
+  313 
+  314 
+  315 -- | @freezeAtPercentage time animation@ creates an animation consisting of stationary frame,
+  316 -- that would be displayed in the provided @animation@ at given @time@.
+  317 -- The duration of the new animation is the same as the duration of provided @animation@.
+  318 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
+  319                    -> Animation -- ^ original animation, from which the frame will be taken
+  320                    -> Animation -- ^ new animation consisting of static frame displayed for the duration of the original animation
+  321 freezeAtPercentage frac (Animation d genFrame) =
+  322   Animation d $ const $ genFrame frac
+  323 
+  324 -- | Overlay animation on top of static SVG image.
+  325 --
+  326 --  Example:
+  327 --
+  328 --  > addStatic (mkBackground "lightblue") drawCircle
+  329 --
+  330 --  <<docs/gifs/doc_addStatic.gif>>
+  331 addStatic :: SVG -> Animation -> Animation
+  332 addStatic static = mapA (\frame -> mkGroup [static, frame])
+  333 
+  334 -- | Modify the time component of an animation. Animation duration is unchanged.
+  335 --
+  336 --   Example:
+  337 --
+  338 --   > signalA (fromToS 0.25 0.75) drawCircle
+  339 --
+  340 --   <<docs/gifs/doc_signalA.gif>>
+  341 signalA :: Signal -> Animation -> Animation
+  342 signalA fn (Animation d gen) = Animation d $ gen . fn
+  343 
+  344 -- | @takeA duration animation@ creates a new animation consisting of initial segment of
+  345 --   @animation@ of given @duration@, played at the same rate as the original animation.
+  346 --
+  347 --  The @duration@ parameter is clamped to be between 0 and @animation@'s duration.
+  348 --  New animation duration is equal to (eventually clamped) @duration@.
+  349 takeA :: Duration -> Animation -> Animation
+  350 takeA len (Animation d gen) = Animation len' $ \t ->
+  351     gen (t * len'/d)
+  352   where
+  353     len' = clamp 0 d len
+  354 
+  355 -- | @dropA duration animation@ creates a new animation by dropping initial segment
+  356 --   of length @duration@ from the provided @animation@, played at the same rate as the original animation.
+  357 --
+  358 --  The @duration@ parameter is clamped to be between 0 and @animation@'s duration.
+  359 --  The duration of the resulting animation is duration of provided @animation@ minus (eventually clamped) @duration@.
+  360 dropA :: Duration -> Animation -> Animation
+  361 dropA len (Animation d gen) = Animation len' $ \t ->
+  362     gen (t * len'/d + len/d)
+  363   where
+  364     len' = d - clamp 0 d len
+  365 
+  366 -- | @lastA duration animation@ return the last @duration@ seconds of the animation.
+  367 lastA :: Duration -> Animation -> Animation
+  368 lastA len a = dropA (duration a - len) a
+  369 
+  370 clamp :: Double -> Double -> Double -> Double
+  371 clamp a b number
+  372   | a < b     = max a (min b number)
+  373   | otherwise = max b (min a number)
+  374 
+  375 -- (#) :: a -> (a -> b) -> b
+  376 -- o # f = f o
+  377 
+  378 -- | Ask for an animation frame using a given synchronization policy.
+  379 getAnimationFrame :: Sync -> Animation -> Time -> Duration -> SVG
+  380 getAnimationFrame sync (Animation aDur aGen) t d =
+  381   case sync of
+  382     SyncStretch -> aGen (t/d)
+  383     SyncLoop    -> aGen (takeFrac $ t/aDur)
+  384     SyncDrop    -> if t > aDur then None else aGen (t/aDur)
+  385     SyncFreeze  -> aGen (min 1 $ t/aDur)
+  386   where
+  387     takeFrac f = snd (properFraction f :: (Int, Double))
+  388 
+  389 -- | Animation synchronization policies.
+  390 data Sync
+  391   = SyncStretch
+  392   | SyncLoop
+  393   | SyncDrop
+  394   | SyncFreeze
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Builtin.Documentation.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Builtin.Documentation.hs.html new file mode 100644 index 0000000..d6a0692 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Builtin.Documentation.hs.html @@ -0,0 +1,86 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-|
+    2 Module      : Reanimate.Builtin.Documentation
+    3 Copyright   : Written by David Himmelstrup
+    4 License     : Unlicense
+    5 Maintainer  : lemmih@gmail.com
+    6 Stability   : experimental
+    7 Portability : POSIX
+    8 
+    9 This module contains convenience functions used in documention
+   10 GIFs for a consistent look and feel.
+   11 
+   12 -}
+   13 module Reanimate.Builtin.Documentation where
+   14 
+   15 import Reanimate.Animation
+   16 import Reanimate.Svg
+   17 import Reanimate.Raster
+   18 import Reanimate.Constants
+   19 import Codec.Picture
+   20 
+   21 -- | Default environment for API documentation GIFs.
+   22 docEnv :: Animation -> Animation
+   23 docEnv = mapA $ \svg -> mkGroup
+   24   [ mkBackground "white"
+   25   , withFillOpacity 0 $
+   26     withStrokeWidth 0.1 $
+   27     withStrokeColor "black" (mkGroup [svg]) ]
+   28 
+   29 -- | <<docs/gifs/doc_drawBox.gif>>
+   30 drawBox :: Animation
+   31 drawBox = mkAnimation 2 $ \t ->
+   32   partialSvg t $ pathify $
+   33   mkRect (screenWidth/2) (screenHeight/2)
+   34 
+   35 -- | <<docs/gifs/doc_drawCircle.gif>>
+   36 drawCircle :: Animation
+   37 drawCircle = mkAnimation 2 $ \t ->
+   38   partialSvg t $ pathify $
+   39   mkCircle (screenHeight/3)
+   40 
+   41 -- | <<docs/gifs/doc_drawProgress.gif>>
+   42 drawProgress :: Animation
+   43 drawProgress = mkAnimation 2 $ \t ->
+   44   mkGroup
+   45   [ mkLine (-screenWidth/2*widthP,0)
+   46            (screenWidth/2*widthP,0)
+   47   , translate (-screenWidth/2*widthP + screenWidth*widthP*t) 0 $
+   48     withFillOpacity 1 $ mkCircle 0.5 ]
+   49   where
+   50     widthP = 0.8
+   51 
+   52 -- | Render a full-screen view of a color-map.
+   53 showColorMap :: (Double -> PixelRGB8) -> SVG
+   54 showColorMap f = center $ scaleToSize screenWidth screenHeight $ embedImage img
+   55   where
+   56     width = 256
+   57     height = 1
+   58     img = generateImage pixelRenderer width height
+   59     pixelRenderer x _y = f (fromIntegral x / fromIntegral (width-1))
+   60 
+   61 -- | Default background color for videos on reanimate.rtfd.io
+   62 rtfdBackgroundColor :: PixelRGBA8
+   63 rtfdBackgroundColor = PixelRGBA8 252 252 252 0xFF
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Builtin.Images.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Builtin.Images.hs.html new file mode 100644 index 0000000..5be7e8b --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Builtin.Images.hs.html @@ -0,0 +1,91 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-|
+    2 Module      : Reanimate.Builtin.Images
+    3 Copyright   : Written by David Himmelstrup
+    4 License     : Unlicense
+    5 Maintainer  : lemmih@gmail.com
+    6 Stability   : experimental
+    7 Portability : POSIX
+    8 
+    9 Collection of built-in images.
+   10 
+   11 -}
+   12 module Reanimate.Builtin.Images
+   13   ( svgLogo
+   14   , haskellLogo
+   15   , githubIcon
+   16   , githubWhiteIcon
+   17   , smallEarth
+   18   ) where
+   19 
+   20 import           Codec.Picture
+   21 import qualified Data.ByteString     as B
+   22 import           Graphics.SvgTree    (parseSvgFile)
+   23 import           Paths_reanimate
+   24 import           Reanimate.Animation
+   25 import           Reanimate.Svg
+   26 import           System.IO.Unsafe
+   27 
+   28 embedImage :: FilePath -> IO SVG
+   29 embedImage key = do
+   30   svg_file <- getDataFileName key
+   31   svg_data <- B.readFile svg_file
+   32   case parseSvgFile svg_file svg_data of
+   33     Nothing  -> error "Malformed svg"
+   34     Just svg -> return $ embedDocument svg
+   35 
+   36 loadJPG :: FilePath -> Image PixelRGBA8
+   37 loadJPG key = unsafePerformIO $ do
+   38   jpg_file <- getDataFileName key
+   39   dat <- B.readFile jpg_file
+   40   case decodeJpeg dat of
+   41     Left err  -> error err
+   42     Right img -> return $ convertRGBA8 img
+   43 
+   44 {- HLINT ignore svgLogo -}
+   45 -- | <<docs/gifs/doc_svgLogo.gif>>
+   46 svgLogo :: SVG
+   47 svgLogo = unsafePerformIO $ embedImage "data/svg-logo.svg"
+   48 
+   49 {- HLINT ignore haskellLogo -}
+   50 -- | <<docs/gifs/doc_haskellLogo.gif>>
+   51 haskellLogo :: SVG
+   52 haskellLogo = unsafePerformIO $ embedImage "data/haskell.svg"
+   53 
+   54 {- HLINT ignore githubIcon -}
+   55 -- | <<docs/gifs/doc_githubIcon.gif>>
+   56 githubIcon :: SVG
+   57 githubIcon = unsafePerformIO $ embedImage "data/github-icon.svg"
+   58 
+   59 {-# NOINLINE githubWhiteIcon #-}
+   60 -- | <<docs/gifs/doc_githubWhiteIcon.gif>>
+   61 githubWhiteIcon :: SVG
+   62 githubWhiteIcon = unsafePerformIO $ embedImage "data/github-icon-white.svg"
+   63 
+   64 -- | 300x150 equirectangular earth
+   65 --
+   66 --   <<docs/gifs/doc_smallEarth.gif>>
+   67 smallEarth :: Image PixelRGBA8
+   68 smallEarth = loadJPG "data/small_earth.jpg"
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Builtin.Slide.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Builtin.Slide.hs.html new file mode 100644 index 0000000..9e8a6c2 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Builtin.Slide.hs.html @@ -0,0 +1,60 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-|
+    2 Copyright   : Written by David Himmelstrup
+    3 License     : Unlicense
+    4 Maintainer  : lemmih@gmail.com
+    5 Stability   : experimental
+    6 Portability : POSIX
+    7 -}
+    8 module Reanimate.Builtin.Slide where
+    9 
+   10 import Reanimate.Transition
+   11 import Reanimate.Constants
+   12 import Reanimate.Svg
+   13 import Reanimate.Effect
+   14 
+   15 -- | <<docs/gifs/doc_slideLeftT.gif>>
+   16 slideLeftT :: Transition
+   17 slideLeftT = effectT slideLeft (andE slideLeft moveRight)
+   18   where
+   19     slideLeft = translateE (-screenWidth) 0
+   20     moveRight = constE (translate screenWidth 0)
+   21     andE a b d t = a d t . b d t
+   22 
+   23 -- | <<docs/gifs/doc_slideDownT.gif>>
+   24 slideDownT :: Transition
+   25 slideDownT = effectT slideDown (andE slideDown moveUp)
+   26   where
+   27     slideDown = translateE 0 (-screenHeight)
+   28     moveUp = constE (translate 0 screenHeight)
+   29     andE a b d t = a d t . b d t
+   30 
+   31 -- | <<docs/gifs/doc_slideUpT.gif>>
+   32 slideUpT :: Transition
+   33 slideUpT = effectT slideUp (andE slideUp moveDown)
+   34   where
+   35     slideUp = translateE 0 screenHeight
+   36     moveDown = constE (translate 0 (-screenHeight))
+   37     andE a b d t = a d t . b d t
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Cache.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Cache.hs.html new file mode 100644 index 0000000..0499e9a --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Cache.hs.html @@ -0,0 +1,134 @@ + + + + + + +
+never executed always true always false
+
+
+    1 module Reanimate.Cache
+    2   ( cacheFile -- :: FilePath -> (FilePath -> IO ()) -> IO FilePath
+    3   , cacheMem
+    4   , cacheDisk
+    5   , cacheDiskSvg
+    6   , cacheDiskKey
+    7   , cacheDiskLines
+    8   , encodeInt
+    9   ) where
+   10 
+   11 import           Control.Exception
+   12 import           Control.Monad       (unless)
+   13 import           Data.Bits
+   14 import           Data.Hashable
+   15 import           Data.IORef
+   16 import           Data.Map            (Map)
+   17 import qualified Data.Map            as Map
+   18 import           Data.Text           (Text)
+   19 import qualified Data.Text           as T
+   20 import qualified Data.Text.IO        as T
+   21 import           Graphics.SvgTree    (Tree (..), unparse)
+   22 import           Reanimate.Animation (renderTree)
+   23 import           Reanimate.Misc      (renameOrCopyFile)
+   24 import           System.Directory
+   25 import           System.FilePath
+   26 import           System.IO
+   27 import           System.IO.Temp
+   28 import           System.IO.Unsafe
+   29 import           Text.XML.Light      (Content (..), parseXML)
+   30 
+   31 -- Memory cache and disk cache
+   32 
+   33 cacheFile :: FilePath -> (FilePath -> IO ()) -> IO FilePath
+   34 cacheFile template gen = do
+   35     root <- getXdgDirectory XdgCache "reanimate"
+   36     createDirectoryIfMissing True root
+   37     let path = root </> template
+   38     hit <- doesFileExist path
+   39     unless hit $ withSystemTempFile template $ \tmp h -> do
+   40       hClose h
+   41       gen tmp
+   42       renameOrCopyFile tmp path
+   43     evaluate path
+   44 
+   45 cacheDisk :: String -> (T.Text -> Maybe a) -> (a -> T.Text) -> (Text -> IO a) -> (Text -> IO a)
+   46 cacheDisk cacheType parse render gen key = do
+   47     root <- getXdgDirectory XdgCache "reanimate"
+   48     createDirectoryIfMissing True root
+   49     let path = root </> encodeInt (hash key) <.> cacheType
+   50     hit <- doesFileExist path
+   51     if hit
+   52       then do
+   53         inp <- T.readFile path
+   54         case parse inp of
+   55           Nothing  -> genCache root path
+   56           Just val -> pure val
+   57       else genCache root path
+   58   where
+   59     genCache root path = do
+   60       (tmpPath, tmpHandle) <- openTempFile root (encodeInt (hash key))
+   61       new <- gen key
+   62       T.hPutStr tmpHandle (render new)
+   63       hClose tmpHandle
+   64       renameOrCopyFile tmpPath path
+   65       return new
+   66 
+   67 cacheDiskKey :: Text -> IO Tree -> IO Tree
+   68 cacheDiskKey key gen = cacheDiskSvg (const gen) key
+   69 
+   70 cacheDiskSvg :: (Text -> IO Tree) -> (Text -> IO Tree)
+   71 cacheDiskSvg = cacheDisk "svg" parse render
+   72   where
+   73     parse txt = case parseXML txt of
+   74       [Elem t] -> Just (unparse t)
+   75       _        -> Nothing
+   76     render = T.pack . renderTree
+   77 
+   78 cacheDiskLines :: (Text -> IO [Text]) -> (Text -> IO [Text])
+   79 cacheDiskLines = cacheDisk "txt" parse render
+   80   where
+   81     parse = Just . T.lines
+   82     render = T.unlines
+   83 
+   84 
+   85 {-# NOINLINE cache #-}
+   86 cache :: IORef (Map Text Tree)
+   87 cache = unsafePerformIO (newIORef Map.empty)
+   88 
+   89 cacheMem :: (Text -> IO Tree) -> (Text -> IO Tree)
+   90 cacheMem gen key = do
+   91   store <- readIORef cache
+   92   case Map.lookup key store of
+   93     Just svg -> return svg
+   94     Nothing -> do
+   95       svg <- gen key
+   96       case svg of
+   97         -- None usually indicates that latex or another tool was misconfigured. In this case,
+   98         -- don't store the result.
+   99         None -> pure None
+  100         _    -> atomicModifyIORef cache (\m -> (Map.insert key svg m, svg))
+  101 
+  102 encodeInt :: Int -> String
+  103 encodeInt i = worker (fromIntegral i) 60
+  104   where
+  105     worker :: Word -> Int -> String
+  106     worker key sh
+  107       | sh < 0 = []
+  108       | otherwise =
+  109         case (key `shiftR` sh) `mod` 64 of
+  110           idx -> alphabet !! fromIntegral idx : worker key (sh-6)
+  111     alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+$"
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.ColorComponents.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.ColorComponents.hs.html new file mode 100644 index 0000000..3256f3c --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.ColorComponents.hs.html @@ -0,0 +1,152 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE RecordWildCards #-}
+    2 {- |
+    3   Colors are three dimensional and can be projected into many color spaces
+    4   with different properties.
+    5 
+    6   Interpolating directly in the RGB color space is unintuitive and rarely useful.
+    7   If you want to transition through color, you most likely want either the XYZ space
+    8   (for physically accurate color transitions) or the LAB space (for esthetically
+    9   pleasing colors).
+   10 -}
+   11 module Reanimate.ColorComponents
+   12   ( ColorComponents(..)
+   13   , rgbComponents
+   14   , hsvComponents
+   15   , labComponents
+   16   , xyzComponents
+   17   , lchComponents
+   18   , interpolate
+   19   , interpolateRGB8
+   20   , interpolateRGBA8
+   21   , toRGB8
+   22   , fromRGB8
+   23   ) where
+   24 
+   25 import           Codec.Picture
+   26 import           Codec.Picture.Types
+   27 import           Data.Colour
+   28 import           Data.Colour.CIE
+   29 import           Data.Colour.CIE.Illuminant (d65)
+   30 import           Data.Colour.RGBSpace
+   31 import           Data.Colour.RGBSpace.HSV
+   32 import           Data.Colour.SRGB
+   33 import           Data.Fixed
+   34 import           Reanimate.Ease
+   35 
+   36 -- | Constructor and destructor for color's three components.
+   37 data ColorComponents = ColorComponents
+   38   { colorUnpack :: Colour Double -> (Double, Double, Double)
+   39     -- ^ Unpack a color into its three components.
+   40   , colorPack   :: Double -> Double -> Double -> Colour Double
+   41     -- ^ Restore a color from three coordinates.
+   42   }
+   43 
+   44 -- | > interpolate rgbComponents yellow blue
+   45 --
+   46 --   <<docs/gifs/doc_rgbComponents.gif>>
+   47 rgbComponents :: ColorComponents
+   48 rgbComponents = ColorComponents rgbUnpack sRGB
+   49   where
+   50     rgbUnpack :: Colour Double -> (Double, Double, Double)
+   51     rgbUnpack c =
+   52       case toSRGB c of
+   53         RGB r g b -> (r,g,b)
+   54 
+   55 -- | > interpolate hsvComponents yellow blue
+   56 --
+   57 --   <<docs/gifs/doc_hsvComponents.gif>>
+   58 hsvComponents :: ColorComponents
+   59 hsvComponents = ColorComponents unpack pack
+   60   where
+   61     unpack = hsvView.toSRGB
+   62     pack a b c = uncurryRGB sRGB $ hsv a b c
+   63 
+   64 -- | > interpolate labComponents yellow blue
+   65 --
+   66 --   <<docs/gifs/doc_labComponents.gif>>
+   67 labComponents :: ColorComponents
+   68 labComponents = ColorComponents unpack pack
+   69   where
+   70     unpack = cieLABView d65
+   71     pack = cieLAB d65
+   72 
+   73 -- | > interpolate xyzComponents yellow blue
+   74 --
+   75 --   <<docs/gifs/doc_xyzComponents.gif>>
+   76 xyzComponents :: ColorComponents
+   77 xyzComponents = ColorComponents cieXYZView cieXYZ
+   78 
+   79 -- | > interpolate lchComponents yellow blue
+   80 --
+   81 --   <<docs/gifs/doc_lchComponents.gif>>
+   82 lchComponents :: ColorComponents
+   83 lchComponents = ColorComponents unpack pack
+   84   where
+   85     toDeg,toRad :: Double -> Double
+   86     toRad deg = deg/180 * pi
+   87     toDeg rad = rad/pi * 180
+   88     unpack :: Colour Double -> (Double, Double, Double)
+   89     unpack color =
+   90       let (l,a,b) = cieLABView d65 color
+   91           c = sqrt (a*a + b*b)
+   92           h :: Double
+   93           h = (toDeg(atan2 b a) + 360) `mod'` 360
+   94           isZero = round (c*10000) == (0::Integer)
+   95       in (l, c, if isZero then 0/0 else h)
+   96     pack l c h =
+   97       cieLAB d65 l (cos (toRad h) * c) (sin (toRad h) * c)
+   98 
+   99 -- | Smoothly interpolate between two colors using the given color components.
+  100 interpolate :: ColorComponents -> Colour Double -> Colour Double -> (Double -> Colour Double)
+  101 interpolate ColorComponents{..} from to = \d ->
+  102     colorPack (a1 + (a2-a1)*d) (b1 + (b2-b1)*d) (c1 + (c2-c1)*d)
+  103   where
+  104     (a1,b1,c1) = colorUnpack from
+  105     (a2,b2,c2) = colorUnpack to
+  106 
+  107 -- | Convenience interpolation function for RGB8 values.
+  108 interpolateRGB8 :: ColorComponents -> PixelRGB8 -> PixelRGB8 -> (Double -> PixelRGB8)
+  109 interpolateRGB8 comps from to = toRGB8 . interpolate comps (fromRGB8 from) (fromRGB8 to)
+  110 
+  111 -- | Convenience interpolation function for RGBA8 values.
+  112 interpolateRGBA8 :: ColorComponents -> PixelRGBA8 -> PixelRGBA8 -> (Double -> PixelRGBA8)
+  113 interpolateRGBA8 comps from to = \t ->
+  114   case interp t of
+  115     PixelRGB8 r g b ->
+  116       let alpha = fromToS (fromIntegral $ pixelOpacity from) (fromIntegral $ pixelOpacity to) t
+  117       in PixelRGBA8 r g b (round alpha)
+  118   where
+  119     interp = interpolateRGB8 comps (dropTransparency from) (dropTransparency to)
+  120 
+  121 -- | Convenience function for expressing a color as an RGB8 value.
+  122 toRGB8 :: Colour Double -> PixelRGB8
+  123 toRGB8 c = PixelRGB8 r g b
+  124   where
+  125     RGB r g b = toSRGBBounded c
+  126 
+  127 -- | Convenience function for expressing an RGB8 value as a color.
+  128 fromRGB8 :: PixelRGB8 -> Colour Double
+  129 fromRGB8 (PixelRGB8 r g b) = sRGB24 r g b
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.ColorMap.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.ColorMap.hs.html new file mode 100644 index 0000000..bd99486 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.ColorMap.hs.html @@ -0,0 +1,533 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE OverloadedStrings #-}
+    2 {-|
+    3   A colormap takes a number between 0 and 1 (inclusive) and spits out a color.
+    4   The colors do not have an alpha component but one can be added with
+    5   `Codec.Picture.Types.promotePixel`.
+    6 -}
+    7 module Reanimate.ColorMap
+    8   ( turbo
+    9   , viridis
+   10   , magma
+   11   , inferno
+   12   , plasma
+   13   , sinebow
+   14   , parula
+   15   , cividis
+   16   , jet
+   17   , hsv
+   18   , hsvMatlab
+   19   , greyscale
+   20   ) where
+   21 
+   22 import Data.Text (Text)
+   23 import Data.Vector (Vector)
+   24 import qualified Data.Text as T
+   25 import qualified Data.Vector as V
+   26 import Codec.Picture
+   27 import Data.Char
+   28 import Data.Bits
+   29 import qualified Data.Colour.RGBSpace.HSV as HSV
+   30 import           Data.Colour.RGBSpace
+   31 
+   32 -- | Given a number t in the range [0,1], returns the corresponding color from
+   33 --   the “turbo” color scheme by Anton Mikhailov.
+   34 --
+   35 --   <<docs/gifs/doc_turbo.gif>>
+   36 turbo :: Double -> PixelRGB8
+   37 turbo t = PixelRGB8 red green blue
+   38   where
+   39     red   = trunc (round (34.61 + t * (1172.33 - t * (10793.56 - t * (33300.12 - t * (38394.49 - t * 14825.05))))))
+   40     green = trunc (round (23.31 + t * (557.33 + t * (1225.33 - t * (3574.96 - t * (1073.77 + t * 707.56))))))
+   41     blue  = trunc (round (27.2 + t * (3211.1 - t * (15327.97 - t * (27814 - t * (22569.18 - t * 6838.66))))))
+   42     trunc :: Integer -> Pixel8
+   43     trunc = fromIntegral . min 255 . max 0
+   44 
+   45 -- | Given a number t in the range [0,1], returns the corresponding color from
+   46 --   the “viridis” perceptually-uniform color scheme designed by van der Walt,
+   47 --   Smith and Firing for matplotlib, represented as an RGB string.
+   48 --
+   49 --   <<docs/gifs/doc_viridis.gif>>
+   50 viridis :: Double -> PixelRGB8
+   51 viridis = ramp (colors
+   52   "44015444025645045745055946075a46085c460a5d460b5e470d60470e614710634711644713\
+   53   \6548146748166848176948186a481a6c481b6d481c6e481d6f481f7048207148217348237448\
+   54   \2475482576482677482878482979472a7a472c7a472d7b472e7c472f7d46307e46327e46337f\
+   55   \463480453581453781453882443983443a83443b84433d84433e85423f854240864241864142\
+   56   \874144874045884046883f47883f48893e49893e4a893e4c8a3d4d8a3d4e8a3c4f8a3c508b3b\
+   57   \518b3b528b3a538b3a548c39558c39568c38588c38598c375a8c375b8d365c8d365d8d355e8d\
+   58   \355f8d34608d34618d33628d33638d32648e32658e31668e31678e31688e30698e306a8e2f6b\
+   59   \8e2f6c8e2e6d8e2e6e8e2e6f8e2d708e2d718e2c718e2c728e2c738e2b748e2b758e2a768e2a\
+   60   \778e2a788e29798e297a8e297b8e287c8e287d8e277e8e277f8e27808e26818e26828e26828e\
+   61   \25838e25848e25858e24868e24878e23888e23898e238a8d228b8d228c8d228d8d218e8d218f\
+   62   \8d21908d21918c20928c20928c20938c1f948c1f958b1f968b1f978b1f988b1f998a1f9a8a1e\
+   63   \9b8a1e9c891e9d891f9e891f9f881fa0881fa1881fa1871fa28720a38620a48621a58521a685\
+   64   \22a78522a88423a98324aa8325ab8225ac8226ad8127ad8128ae8029af7f2ab07f2cb17e2db2\
+   65   \7d2eb37c2fb47c31b57b32b67a34b67935b77937b87838b9773aba763bbb753dbc743fbc7340\
+   66   \bd7242be7144bf7046c06f48c16e4ac16d4cc26c4ec36b50c46a52c56954c56856c66758c765\
+   67   \5ac8645cc8635ec96260ca6063cb5f65cb5e67cc5c69cd5b6ccd5a6ece5870cf5773d05675d0\
+   68   \5477d1537ad1517cd2507fd34e81d34d84d44b86d54989d5488bd6468ed64590d74393d74195\
+   69   \d84098d83e9bd93c9dd93ba0da39a2da37a5db36a8db34aadc32addc30b0dd2fb2dd2db5de2b\
+   70   \b8de29bade28bddf26c0df25c2df23c5e021c8e020cae11fcde11dd0e11cd2e21bd5e21ad8e2\
+   71   \19dae319dde318dfe318e2e418e5e419e7e419eae51aece51befe51cf1e51df4e61ef6e620f8\
+   72   \e621fbe723fde725")
+   73 
+   74 -- | Given a number t in the range [0,1], returns the corresponding color from
+   75 --   the “magma” perceptually-uniform color scheme designed by van der Walt and
+   76 --   Smith for matplotlib, represented as an RGB string.
+   77 --
+   78 --   <<docs/gifs/doc_magma.gif>>
+   79 magma :: Double -> PixelRGB8
+   80 magma = ramp (colors
+   81   "00000401000501010601010802010902020b02020d03030f0303120404140504160605180605\
+   82   \1a07061c08071e0907200a08220b09240c09260d0a290e0b2b100b2d110c2f120d31130d3414\
+   83   \0e36150e38160f3b180f3d19103f1a10421c10441d11471e114920114b21114e221150241253\
+   84   \25125527125829115a2a115c2c115f2d11612f116331116533106734106936106b38106c390f\
+   85   \6e3b0f703d0f713f0f72400f74420f75440f764510774710784910784a10794c117a4e117b4f\
+   86   \127b51127c52137c54137d56147d57157e59157e5a167e5c167f5d177f5f187f601880621980\
+   87   \641a80651a80671b80681c816a1c816b1d816d1d816e1e81701f81721f817320817521817621\
+   88   \817822817922827b23827c23827e24828025828125818326818426818627818827818928818b\
+   89   \29818c29818e2a81902a81912b81932b80942c80962c80982d80992d809b2e7f9c2e7f9e2f7f\
+   90   \a02f7fa1307ea3307ea5317ea6317da8327daa337dab337cad347cae347bb0357bb2357bb336\
+   91   \7ab5367ab73779b83779ba3878bc3978bd3977bf3a77c03a76c23b75c43c75c53c74c73d73c8\
+   92   \3e73ca3e72cc3f71cd4071cf4070d0416fd2426fd3436ed5446dd6456cd8456cd9466bdb476a\
+   93   \dc4869de4968df4a68e04c67e24d66e34e65e44f64e55064e75263e85362e95462ea5661eb57\
+   94   \60ec5860ed5a5fee5b5eef5d5ef05f5ef1605df2625df2645cf3655cf4675cf4695cf56b5cf6\
+   95   \6c5cf66e5cf7705cf7725cf8745cf8765cf9785df9795df97b5dfa7d5efa7f5efa815ffb835f\
+   96   \fb8560fb8761fc8961fc8a62fc8c63fc8e64fc9065fd9266fd9467fd9668fd9869fd9a6afd9b\
+   97   \6bfe9d6cfe9f6dfea16efea36ffea571fea772fea973feaa74feac76feae77feb078feb27afe\
+   98   \b47bfeb67cfeb77efeb97ffebb81febd82febf84fec185fec287fec488fec68afec88cfeca8d\
+   99   \fecc8ffecd90fecf92fed194fed395fed597fed799fed89afdda9cfddc9efddea0fde0a1fde2\
+  100   \a3fde3a5fde5a7fde7a9fde9aafdebacfcecaefceeb0fcf0b2fcf2b4fcf4b6fcf6b8fcf7b9fc\
+  101   \f9bbfcfbbdfcfdbf")
+  102 
+  103 -- | Given a number t in the range [0,1], returns the corresponding color from
+  104 --   the “inferno” perceptually-uniform color scheme designed by van der Walt
+  105 --   and Smith for matplotlib, represented as an RGB string.
+  106 --
+  107 --   <<docs/gifs/doc_inferno.gif>>
+  108 inferno :: Double -> PixelRGB8
+  109 inferno = ramp (colors
+  110   "00000401000501010601010802010a02020c02020e0302100403120403140504170604190705\
+  111   \1b08051d09061f0a07220b07240c08260d08290e092b10092d110a30120a32140b34150b3716\
+  112   \0b39180c3c190c3e1b0c411c0c431e0c451f0c48210c4a230c4c240c4f260c51280b53290b55\
+  113   \2b0b572d0b592f0a5b310a5c320a5e340a5f3609613809623909633b09643d09653e0966400a\
+  114   \67420a68440a68450a69470b6a490b6a4a0c6b4c0c6b4d0d6c4f0d6c510e6c520e6d540f6d55\
+  115   \0f6d57106e59106e5a116e5c126e5d126e5f136e61136e62146e64156e65156e67166e69166e\
+  116   \6a176e6c186e6d186e6f196e71196e721a6e741a6e751b6e771c6d781c6d7a1d6d7c1d6d7d1e\
+  117   \6d7f1e6c801f6c82206c84206b85216b87216b88226a8a226a8c23698d23698f246990256892\
+  118   \25689326679526679727669827669a28659b29649d29649f2a63a02a63a22b62a32c61a52c60\
+  119   \a62d60a82e5fa92e5eab2f5ead305dae305cb0315bb1325ab3325ab43359b63458b73557b935\
+  120   \56ba3655bc3754bd3853bf3952c03a51c13a50c33b4fc43c4ec63d4dc73e4cc83f4bca404acb\
+  121   \4149cc4248ce4347cf4446d04545d24644d34743d44842d54a41d74b3fd84c3ed94d3dda4e3c\
+  122   \db503bdd513ade5238df5337e05536e15635e25734e35933e45a31e55c30e65d2fe75e2ee860\
+  123   \2de9612bea632aeb6429eb6628ec6726ed6925ee6a24ef6c23ef6e21f06f20f1711ff1731df2\
+  124   \741cf3761bf37819f47918f57b17f57d15f67e14f68013f78212f78410f8850ff8870ef8890c\
+  125   \f98b0bf98c0af98e09fa9008fa9207fa9407fb9606fb9706fb9906fb9b06fb9d07fc9f07fca1\
+  126   \08fca309fca50afca60cfca80dfcaa0ffcac11fcae12fcb014fcb216fcb418fbb61afbb81dfb\
+  127   \ba1ffbbc21fbbe23fac026fac228fac42afac62df9c72ff9c932f9cb35f8cd37f8cf3af7d13d\
+  128   \f7d340f6d543f6d746f5d949f5db4cf4dd4ff4df53f4e156f3e35af3e55df2e661f2e865f2ea\
+  129   \69f1ec6df1ed71f1ef75f1f179f2f27df2f482f3f586f3f68af4f88ef5f992f6fa96f8fb9af9\
+  130   \fc9dfafda1fcffa4")
+  131 
+  132 -- | Given a number t in the range [0,1], returns the corresponding color from
+  133 --   the “plasma” perceptually-uniform color scheme designed by van der Walt and
+  134 --   Smith for matplotlib, represented as an RGB string.
+  135 --
+  136 --   <<docs/gifs/doc_plasma.gif>>
+  137 plasma :: Double -> PixelRGB8
+  138 plasma = ramp (colors
+  139   "0d088710078813078916078a19068c1b068d1d068e20068f2206902406912605912805922a05\
+  140   \932c05942e05952f059631059733059735049837049938049a3a049a3c049b3e049c3f049c41\
+  141   \049d43039e44039e46039f48039f4903a04b03a14c02a14e02a25002a25102a35302a35502a4\
+  142   \5601a45801a45901a55b01a55c01a65e01a66001a66100a76300a76400a76600a76700a86900\
+  143   \a86a00a86c00a86e00a86f00a87100a87201a87401a87501a87701a87801a87a02a87b02a87d\
+  144   \03a87e03a88004a88104a78305a78405a78606a68707a68808a68a09a58b0aa58d0ba58e0ca4\
+  145   \8f0da4910ea3920fa39410a29511a19613a19814a099159f9a169f9c179e9d189d9e199da01a\
+  146   \9ca11b9ba21d9aa31e9aa51f99a62098a72197a82296aa2395ab2494ac2694ad2793ae2892b0\
+  147   \2991b12a90b22b8fb32c8eb42e8db52f8cb6308bb7318ab83289ba3388bb3488bc3587bd3786\
+  148   \be3885bf3984c03a83c13b82c23c81c33d80c43e7fc5407ec6417dc7427cc8437bc9447aca45\
+  149   \7acb4679cc4778cc4977cd4a76ce4b75cf4c74d04d73d14e72d24f71d35171d45270d5536fd5\
+  150   \546ed6556dd7566cd8576bd9586ada5a6ada5b69db5c68dc5d67dd5e66de5f65de6164df6263\
+  151   \e06363e16462e26561e26660e3685fe4695ee56a5de56b5de66c5ce76e5be76f5ae87059e971\
+  152   \58e97257ea7457eb7556eb7655ec7754ed7953ed7a52ee7b51ef7c51ef7e50f07f4ff0804ef1\
+  153   \814df1834cf2844bf3854bf3874af48849f48948f58b47f58c46f68d45f68f44f79044f79143\
+  154   \f79342f89441f89540f9973ff9983ef99a3efa9b3dfa9c3cfa9e3bfb9f3afba139fba238fca3\
+  155   \38fca537fca636fca835fca934fdab33fdac33fdae32fdaf31fdb130fdb22ffdb42ffdb52efe\
+  156   \b72dfeb82cfeba2cfebb2bfebd2afebe2afec029fdc229fdc328fdc527fdc627fdc827fdca26\
+  157   \fdcb26fccd25fcce25fcd025fcd225fbd324fbd524fbd724fad824fada24f9dc24f9dd25f8df\
+  158   \25f8e125f7e225f7e425f6e626f6e826f5e926f5eb27f4ed27f3ee27f3f027f2f227f1f426f1\
+  159   \f525f0f724f0f921")
+  160 
+  161 -- | Given a number t in the range [0,1], returns the corresponding color from
+  162 --   the “sinebow” color scheme by Jim Bumgardner and Charlie Loyd.
+  163 --
+  164 --   <<docs/gifs/doc_sinebow.gif>>
+  165 sinebow :: Double -> PixelRGB8
+  166 sinebow t = PixelRGB8 r g b
+  167   where
+  168     pi_1_3 = pi / 3
+  169     pi_2_3 = pi * 2 / 3
+  170     x = (0.5 - t) * pi
+  171     r = round $ 255 * sin x**2
+  172     g = round $ 255 * sin (x+pi_1_3)**2
+  173     b = round $ 255 * sin (x+pi_2_3)**2
+  174 
+  175 -- | Given a number t in the range [0,1], returns the corresponding color from
+  176 --   the “cividis” color vision deficiency-optimized color scheme designed by
+  177 --   Nuñez, Anderton, and Renslow, represented as an RGB string.
+  178 --
+  179 --   <<docs/gifs/doc_cividis.gif>>
+  180 cividis :: Double -> PixelRGB8
+  181 cividis t = PixelRGB8 red green blue
+  182   where
+  183     red   = trunc $ round(-4.54 - t * (35.34 - t * (2381.73 - t * (6402.7 - t * (7024.72 - t * 2710.57)))))
+  184     green = trunc $ round(32.49 + t * (170.73 + t * (52.82 - t * (131.46 - t * (176.58 - t * 67.37)))))
+  185     blue  = trunc $ round(81.24 + t * (442.36 - t * (2482.43 - t * (6167.24 - t * (6614.94 - t * 2475.67)))))
+  186     trunc :: Integer -> Pixel8
+  187     trunc = fromIntegral . min 255 . max 0
+  188 
+  189 -- | Jet colormap. Used to be the default in matlab. Obsolete.
+  190 --
+  191 --   <<docs/gifs/doc_jet.gif>>
+  192 jet :: Double -> PixelRGB8
+  193 jet t = PixelRGB8 red green blue
+  194   where
+  195     red   = trunc $ min (4*t - 1.5) (-4*t + 4.5)
+  196     green = trunc $ min (4*t - 0.5) (-4*t + 3.5)
+  197     blue  = trunc $ min (4*t + 0.5) (-4*t + 2.5)
+  198     trunc :: Double -> Pixel8
+  199     trunc = round . min 255 . max 0 . (*) 255
+  200 
+  201 -- | hsv colormap. Goes from 0 degrees to 360 degrees.
+  202 --
+  203 --   <<docs/gifs/doc_hsv.gif>>
+  204 hsv :: Double -> PixelRGB8
+  205 hsv t = PixelRGB8 (round $ r*255) (round $ g*255) (round $ b*255)
+  206   where
+  207     RGB r g b = HSV.hsv (t * 360) 1 1
+  208 
+  209 -- | Matlab hsv colormap. Goes from 0 degrees to 330 degrees.
+  210 --
+  211 --   <<docs/gifs/doc_hsvMatlab.gif>>
+  212 hsvMatlab :: Double -> PixelRGB8
+  213 hsvMatlab t = PixelRGB8 (round $ r*255) (round $ g*255) (round $ b*255)
+  214   where
+  215     RGB r g b = HSV.hsv (t * 330) 1 1
+  216 
+  217 -- | Greyscale colormap.
+  218 --
+  219 --   <<docs/gifs/doc_greyscale.gif>>
+  220 greyscale :: Double -> PixelRGB8
+  221 greyscale t = PixelRGB8 v v v
+  222   where
+  223     v = round $ t * 255
+  224 
+  225 -- | Parula is the default colormap for matlab.
+  226 --
+  227 --   <<docs/gifs/doc_parula.gif>>
+  228 parula :: Double -> PixelRGB8
+  229 parula = ramp vec
+  230   where
+  231     vec = V.fromList $ pixels colorList
+  232     pixels [] = []
+  233     pixels (r:g:b:xs) =
+  234       PixelRGB8 (round $ r*255) (round $ g*255) (round $ b*255) :
+  235       pixels xs
+  236     pixels _ = error "Reanimate.ColorMap.parula: Broken data"
+  237     colorList :: [Double]
+  238     colorList =
+  239        [0.2081, 0.1663, 0.5292
+  240        ,0.2091, 0.1721, 0.5411
+  241        ,0.2101, 0.1779, 0.5530
+  242        ,0.2109, 0.1837, 0.5650
+  243        ,0.2116, 0.1895, 0.5771
+  244        ,0.2121, 0.1954, 0.5892
+  245        ,0.2124, 0.2013, 0.6013
+  246        ,0.2125, 0.2072, 0.6135
+  247        ,0.2123, 0.2132, 0.6258
+  248        ,0.2118, 0.2192, 0.6381
+  249        ,0.2111, 0.2253, 0.6505
+  250        ,0.2099, 0.2315, 0.6629
+  251        ,0.2084, 0.2377, 0.6753
+  252        ,0.2063, 0.2440, 0.6878
+  253        ,0.2038, 0.2503, 0.7003
+  254        ,0.2006, 0.2568, 0.7129
+  255        ,0.1968, 0.2632, 0.7255
+  256        ,0.1921, 0.2698, 0.7381
+  257        ,0.1867, 0.2764, 0.7507
+  258        ,0.1802, 0.2832, 0.7634
+  259        ,0.1728, 0.2902, 0.7762
+  260        ,0.1641, 0.2975, 0.7890
+  261        ,0.1541, 0.3052, 0.8017
+  262        ,0.1427, 0.3132, 0.8145
+  263        ,0.1295, 0.3217, 0.8269
+  264        ,0.1147, 0.3306, 0.8387
+  265        ,0.0986, 0.3397, 0.8495
+  266        ,0.0816, 0.3486, 0.8588
+  267        ,0.0646, 0.3572, 0.8664
+  268        ,0.0482, 0.3651, 0.8722
+  269        ,0.0329, 0.3724, 0.8765
+  270        ,0.0213, 0.3792, 0.8796
+  271        ,0.0136, 0.3853, 0.8815
+  272        ,0.0086, 0.3911, 0.8827
+  273        ,0.0060, 0.3965, 0.8833
+  274        ,0.0051, 0.4017, 0.8834
+  275        ,0.0054, 0.4066, 0.8831
+  276        ,0.0067, 0.4113, 0.8825
+  277        ,0.0089, 0.4159, 0.8816
+  278        ,0.0116, 0.4203, 0.8805
+  279        ,0.0148, 0.4246, 0.8793
+  280        ,0.0184, 0.4288, 0.8779
+  281        ,0.0223, 0.4329, 0.8763
+  282        ,0.0264, 0.4370, 0.8747
+  283        ,0.0306, 0.4410, 0.8729
+  284        ,0.0349, 0.4449, 0.8711
+  285        ,0.0394, 0.4488, 0.8692
+  286        ,0.0437, 0.4526, 0.8672
+  287        ,0.0477, 0.4564, 0.8652
+  288        ,0.0514, 0.4602, 0.8632
+  289        ,0.0549, 0.4640, 0.8611
+  290        ,0.0582, 0.4677, 0.8589
+  291        ,0.0612, 0.4714, 0.8568
+  292        ,0.0640, 0.4751, 0.8546
+  293        ,0.0666, 0.4788, 0.8525
+  294        ,0.0689, 0.4825, 0.8503
+  295        ,0.0710, 0.4862, 0.8481
+  296        ,0.0729, 0.4899, 0.8460
+  297        ,0.0746, 0.4937, 0.8439
+  298        ,0.0761, 0.4974, 0.8418
+  299        ,0.0773, 0.5012, 0.8398
+  300        ,0.0782, 0.5051, 0.8378
+  301        ,0.0789, 0.5089, 0.8359
+  302        ,0.0794, 0.5129, 0.8341
+  303        ,0.0795, 0.5169, 0.8324
+  304        ,0.0793, 0.5210, 0.8308
+  305        ,0.0788, 0.5251, 0.8293
+  306        ,0.0778, 0.5295, 0.8280
+  307        ,0.0764, 0.5339, 0.8270
+  308        ,0.0746, 0.5384, 0.8261
+  309        ,0.0724, 0.5431, 0.8253
+  310        ,0.0698, 0.5479, 0.8247
+  311        ,0.0668, 0.5527, 0.8243
+  312        ,0.0636, 0.5577, 0.8239
+  313        ,0.0600, 0.5627, 0.8237
+  314        ,0.0562, 0.5677, 0.8234
+  315        ,0.0523, 0.5727, 0.8231
+  316        ,0.0484, 0.5777, 0.8228
+  317        ,0.0445, 0.5826, 0.8223
+  318        ,0.0408, 0.5874, 0.8217
+  319        ,0.0372, 0.5922, 0.8209
+  320        ,0.0342, 0.5968, 0.8198
+  321        ,0.0317, 0.6012, 0.8186
+  322        ,0.0296, 0.6055, 0.8171
+  323        ,0.0279, 0.6097, 0.8154
+  324        ,0.0265, 0.6137, 0.8135
+  325        ,0.0255, 0.6176, 0.8114
+  326        ,0.0248, 0.6214, 0.8091
+  327        ,0.0243, 0.6250, 0.8066
+  328        ,0.0239, 0.6285, 0.8039
+  329        ,0.0237, 0.6319, 0.8010
+  330        ,0.0235, 0.6352, 0.7980
+  331        ,0.0233, 0.6384, 0.7948
+  332        ,0.0231, 0.6415, 0.7916
+  333        ,0.0230, 0.6445, 0.7881
+  334        ,0.0229, 0.6474, 0.7846
+  335        ,0.0227, 0.6503, 0.7810
+  336        ,0.0227, 0.6531, 0.7773
+  337        ,0.0232, 0.6558, 0.7735
+  338        ,0.0238, 0.6585, 0.7696
+  339        ,0.0246, 0.6611, 0.7656
+  340        ,0.0263, 0.6637, 0.7615
+  341        ,0.0282, 0.6663, 0.7574
+  342        ,0.0306, 0.6688, 0.7532
+  343        ,0.0338, 0.6712, 0.7490
+  344        ,0.0373, 0.6737, 0.7446
+  345        ,0.0418, 0.6761, 0.7402
+  346        ,0.0467, 0.6784, 0.7358
+  347        ,0.0516, 0.6808, 0.7313
+  348        ,0.0574, 0.6831, 0.7267
+  349        ,0.0629, 0.6854, 0.7221
+  350        ,0.0692, 0.6877, 0.7173
+  351        ,0.0755, 0.6899, 0.7126
+  352        ,0.0820, 0.6921, 0.7078
+  353        ,0.0889, 0.6943, 0.7029
+  354        ,0.0956, 0.6965, 0.6979
+  355        ,0.1031, 0.6986, 0.6929
+  356        ,0.1104, 0.7007, 0.6878
+  357        ,0.1180, 0.7028, 0.6827
+  358        ,0.1258, 0.7049, 0.6775
+  359        ,0.1335, 0.7069, 0.6723
+  360        ,0.1418, 0.7089, 0.6669
+  361        ,0.1499, 0.7109, 0.6616
+  362        ,0.1585, 0.7129, 0.6561
+  363        ,0.1671, 0.7148, 0.6507
+  364        ,0.1758, 0.7168, 0.6451
+  365        ,0.1849, 0.7186, 0.6395
+  366        ,0.1938, 0.7205, 0.6338
+  367        ,0.2033, 0.7223, 0.6281
+  368        ,0.2128, 0.7241, 0.6223
+  369        ,0.2224, 0.7259, 0.6165
+  370        ,0.2324, 0.7275, 0.6107
+  371        ,0.2423, 0.7292, 0.6048
+  372        ,0.2527, 0.7308, 0.5988
+  373        ,0.2631, 0.7324, 0.5929
+  374        ,0.2735, 0.7339, 0.5869
+  375        ,0.2845, 0.7354, 0.5809
+  376        ,0.2953, 0.7368, 0.5749
+  377        ,0.3064, 0.7381, 0.5689
+  378        ,0.3177, 0.7394, 0.5630
+  379        ,0.3289, 0.7406, 0.5570
+  380        ,0.3405, 0.7417, 0.5512
+  381        ,0.3520, 0.7428, 0.5453
+  382        ,0.3635, 0.7438, 0.5396
+  383        ,0.3753, 0.7446, 0.5339
+  384        ,0.3869, 0.7454, 0.5283
+  385        ,0.3986, 0.7461, 0.5229
+  386        ,0.4103, 0.7467, 0.5175
+  387        ,0.4218, 0.7473, 0.5123
+  388        ,0.4334, 0.7477, 0.5072
+  389        ,0.4447, 0.7482, 0.5021
+  390        ,0.4561, 0.7485, 0.4972
+  391        ,0.4672, 0.7487, 0.4924
+  392        ,0.4783, 0.7489, 0.4877
+  393        ,0.4892, 0.7491, 0.4831
+  394        ,0.5000, 0.7491, 0.4786
+  395        ,0.5106, 0.7492, 0.4741
+  396        ,0.5212, 0.7492, 0.4698
+  397        ,0.5315, 0.7491, 0.4655
+  398        ,0.5418, 0.7490, 0.4613
+  399        ,0.5519, 0.7489, 0.4571
+  400        ,0.5619, 0.7487, 0.4531
+  401        ,0.5718, 0.7485, 0.4490
+  402        ,0.5816, 0.7482, 0.4451
+  403        ,0.5913, 0.7479, 0.4412
+  404        ,0.6009, 0.7476, 0.4374
+  405        ,0.6103, 0.7473, 0.4335
+  406        ,0.6197, 0.7469, 0.4298
+  407        ,0.6290, 0.7465, 0.4261
+  408        ,0.6382, 0.7460, 0.4224
+  409        ,0.6473, 0.7456, 0.4188
+  410        ,0.6564, 0.7451, 0.4152
+  411        ,0.6653, 0.7446, 0.4116
+  412        ,0.6742, 0.7441, 0.4081
+  413        ,0.6830, 0.7435, 0.4046
+  414        ,0.6918, 0.7430, 0.4011
+  415        ,0.7004, 0.7424, 0.3976
+  416        ,0.7091, 0.7418, 0.3942
+  417        ,0.7176, 0.7412, 0.3908
+  418        ,0.7261, 0.7405, 0.3874
+  419        ,0.7346, 0.7399, 0.3840
+  420        ,0.7430, 0.7392, 0.3806
+  421        ,0.7513, 0.7385, 0.3773
+  422        ,0.7596, 0.7378, 0.3739
+  423        ,0.7679, 0.7372, 0.3706
+  424        ,0.7761, 0.7364, 0.3673
+  425        ,0.7843, 0.7357, 0.3639
+  426        ,0.7924, 0.7350, 0.3606
+  427        ,0.8005, 0.7343, 0.3573
+  428        ,0.8085, 0.7336, 0.3539
+  429        ,0.8166, 0.7329, 0.3506
+  430        ,0.8246, 0.7322, 0.3472
+  431        ,0.8325, 0.7315, 0.3438
+  432        ,0.8405, 0.7308, 0.3404
+  433        ,0.8484, 0.7301, 0.3370
+  434        ,0.8563, 0.7294, 0.3336
+  435        ,0.8642, 0.7288, 0.3300
+  436        ,0.8720, 0.7282, 0.3265
+  437        ,0.8798, 0.7276, 0.3229
+  438        ,0.8877, 0.7271, 0.3193
+  439        ,0.8954, 0.7266, 0.3156
+  440        ,0.9032, 0.7262, 0.3117
+  441        ,0.9110, 0.7259, 0.3078
+  442        ,0.9187, 0.7256, 0.3038
+  443        ,0.9264, 0.7256, 0.2996
+  444        ,0.9341, 0.7256, 0.2953
+  445        ,0.9417, 0.7259, 0.2907
+  446        ,0.9493, 0.7264, 0.2859
+  447        ,0.9567, 0.7273, 0.2808
+  448        ,0.9639, 0.7285, 0.2754
+  449        ,0.9708, 0.7303, 0.2696
+  450        ,0.9773, 0.7326, 0.2634
+  451        ,0.9831, 0.7355, 0.2570
+  452        ,0.9882, 0.7390, 0.2504
+  453        ,0.9922, 0.7431, 0.2437
+  454        ,0.9952, 0.7476, 0.2373
+  455        ,0.9973, 0.7524, 0.2310
+  456        ,0.9986, 0.7573, 0.2251
+  457        ,0.9991, 0.7624, 0.2195
+  458        ,0.9990, 0.7675, 0.2141
+  459        ,0.9985, 0.7726, 0.2090
+  460        ,0.9976, 0.7778, 0.2042
+  461        ,0.9964, 0.7829, 0.1995
+  462        ,0.9950, 0.7880, 0.1949
+  463        ,0.9933, 0.7931, 0.1905
+  464        ,0.9914, 0.7981, 0.1863
+  465        ,0.9894, 0.8032, 0.1821
+  466        ,0.9873, 0.8083, 0.1780
+  467        ,0.9851, 0.8133, 0.1740
+  468        ,0.9828, 0.8184, 0.1700
+  469        ,0.9805, 0.8235, 0.1661
+  470        ,0.9782, 0.8286, 0.1622
+  471        ,0.9759, 0.8337, 0.1583
+  472        ,0.9736, 0.8389, 0.1544
+  473        ,0.9713, 0.8441, 0.1505
+  474        ,0.9692, 0.8494, 0.1465
+  475        ,0.9672, 0.8548, 0.1425
+  476        ,0.9654, 0.8603, 0.1385
+  477        ,0.9638, 0.8659, 0.1343
+  478        ,0.9623, 0.8716, 0.1301
+  479        ,0.9611, 0.8774, 0.1258
+  480        ,0.9600, 0.8834, 0.1215
+  481        ,0.9593, 0.8895, 0.1171
+  482        ,0.9588, 0.8958, 0.1126
+  483        ,0.9586, 0.9022, 0.1082
+  484        ,0.9587, 0.9088, 0.1036
+  485        ,0.9591, 0.9155, 0.0990
+  486        ,0.9599, 0.9225, 0.0944
+  487        ,0.9610, 0.9296, 0.0897
+  488        ,0.9624, 0.9368, 0.0850
+  489        ,0.9641, 0.9443, 0.0802
+  490        ,0.9662, 0.9518, 0.0753
+  491        ,0.9685, 0.9595, 0.0703
+  492        ,0.9710, 0.9673, 0.0651
+  493        ,0.9736, 0.9752, 0.0597
+  494        ,0.9763, 0.9831, 0.0538]
+  495 
+  496 --------------------------------------------------------------------------------
+  497 -- Helpers
+  498 
+  499 colors :: Text -> Vector PixelRGB8
+  500 colors = V.fromList . map (toColor . map (fromIntegral . digitToInt) . T.unpack) . T.chunksOf 6
+  501   where
+  502     toColor [r1,r2,g1,g2,b1,b2] =
+  503       PixelRGB8 (r1 `shiftL` 4 + r2) (g1 `shiftL` 4 + g2) (b1 `shiftL` 4+b2)
+  504     toColor _ = error "Reanimate.ColorMap.colors: Broken data"
+  505 
+  506 ramp :: Vector PixelRGB8 -> Double -> PixelRGB8
+  507 ramp v = \t -> v V.! max 0 (min (len-1) $ round $ t * (len'-1))
+  508   where
+  509     len = V.length v
+  510     len' = fromIntegral len
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Constants.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Constants.hs.html new file mode 100644 index 0000000..146a989 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Constants.hs.html @@ -0,0 +1,74 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {- |
+    2   Reanimate configures a consistent, default canvas. The values of this default
+    3   can be observed via the constants in this module. Keep in mind, these values
+    4   describe the /default/ canvas and will not apply to custom viewports.
+    5 -}
+    6 module Reanimate.Constants
+    7   ( screenWidth
+    8   , screenHeight
+    9   , screenTop
+   10   , screenBottom
+   11   , screenLeft
+   12   , screenRight
+   13   , defaultDPI
+   14   , defaultStrokeWidth
+   15   ) where
+   16 
+   17 import           Graphics.SvgTree
+   18 
+   19 -- | Number of units from the left-most point to the right-most point on the screen.
+   20 screenWidth :: Fractional a => a
+   21 
+   22 -- | Number of units from the bottom to the top of the screen.
+   23 screenHeight :: Fractional a => a
+   24 
+   25 -- | Position of the top of the screen.
+   26 screenTop :: Fractional a => a
+   27 
+   28 -- | Position of the bottom of the screen.
+   29 screenBottom :: Fractional a => a
+   30 
+   31 -- | Position of the left side of the screen.
+   32 screenLeft :: Fractional a => a
+   33 
+   34 -- | Position of the right side of the screen.
+   35 screenRight :: Fractional a => a
+   36 
+   37 screenWidth = 16
+   38 screenHeight = 9
+   39 screenTop = screenHeight/2
+   40 screenBottom = -screenHeight/2
+   41 screenLeft = -screenWidth/2
+   42 screenRight = screenWidth/2
+   43 
+   44 -- | SVG allows measurements in inches which have to be converted to local units.
+   45 --   This value describes how many local units there are in an inch.
+   46 defaultDPI :: Dpi
+   47 defaultDPI = 96
+   48 
+   49 -- | Default thickness of lines.
+   50 defaultStrokeWidth :: Double
+   51 defaultStrokeWidth = 0.05
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Driver.CLI.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Driver.CLI.hs.html new file mode 100644 index 0000000..493e067 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Driver.CLI.hs.html @@ -0,0 +1,246 @@ + + + + + + +
+never executed always true always false
+
+
+    1 module Reanimate.Driver.CLI
+    2   ( getDriverOptions
+    3   , Options(..)
+    4   , Command(..)
+    5   , Preset(..)
+    6   , Format(..)
+    7   , Raster(..)
+    8   , showFormat
+    9   , showRaster
+   10   ) where
+   11 
+   12 import           Data.Char
+   13 import           Data.Monoid
+   14 import           Options.Applicative
+   15 import           Prelude
+   16 import           Reanimate.Render    (FPS, Format (..), Height, Raster (..),
+   17                                       Width)
+   18 
+   19 newtype Options = Options
+   20   { optsCommand :: Command
+   21   } deriving (Show)
+   22 
+   23 data Command
+   24   = Raw
+   25     { rawOutputFolder :: FilePath
+   26     , rawFrameOffset  :: Int
+   27     , rawPrettyPrint  :: Bool
+   28     }
+   29   | Test
+   30   | Check
+   31   | View
+   32     { viewVerbose   :: Bool
+   33     , viewGHCPath   :: Maybe FilePath
+   34     , viewGHCOpts   :: [String]
+   35     , viewOrigin    :: Maybe FilePath
+   36     }
+   37   | Render
+   38     { renderTarget  :: Maybe String
+   39     , renderFPS     :: Maybe FPS
+   40     , renderWidth   :: Maybe Width
+   41     , renderHeight  :: Maybe Height
+   42     , renderCompile :: Bool
+   43     , renderFormat  :: Maybe Format
+   44     , renderPreset  :: Maybe Preset
+   45     , renderRaster  :: Raster
+   46     , renderPartial :: Bool
+   47     }
+   48    deriving (Show)
+   49 
+   50 data Preset = Youtube | ExampleGif | Quick | MediumQ | HighQ | LowFPS
+   51   deriving (Show)
+   52 
+   53 readRaster :: String -> Maybe Raster
+   54 readRaster raster =
+   55   case map toLower raster of
+   56     "none"          -> Just RasterNone
+   57     "auto"          -> Just RasterAuto
+   58     "inkscape"      -> Just RasterInkscape
+   59     "rsvg"          -> Just RasterRSvg
+   60     "imagemagick"   -> Just RasterMagick
+   61     _               -> Nothing
+   62 
+   63 showRaster :: Raster -> String
+   64 showRaster RasterNone     = "none"
+   65 showRaster RasterAuto     = "auto"
+   66 showRaster RasterInkscape = "inkscape"
+   67 showRaster RasterRSvg     = "rsvg"
+   68 showRaster RasterMagick   = "imagemagick"
+   69 
+   70 readFormat :: String -> Maybe Format
+   71 readFormat fmt =
+   72   case map toLower fmt of
+   73     "mp4"  -> Just RenderMp4
+   74     "gif"  -> Just RenderGif
+   75     "webm" -> Just RenderWebm
+   76     _      -> Nothing
+   77 
+   78 showFormat :: Format -> String
+   79 showFormat RenderMp4  = "mp4"
+   80 showFormat RenderGif  = "gif"
+   81 showFormat RenderWebm = "webm"
+   82 
+   83 readPreset :: String -> Maybe Preset
+   84 readPreset preset =
+   85   case map toLower preset of
+   86     "youtube" -> Just Youtube
+   87     "gif"     -> Just ExampleGif
+   88     "quick"   -> Just Quick
+   89     "medium"  -> Just MediumQ
+   90     "high"    -> Just HighQ
+   91     "lowfps"  -> Just LowFPS
+   92     _         -> Nothing
+   93 
+   94 showPreset :: Preset -> String
+   95 showPreset Youtube    = "youtube"
+   96 showPreset ExampleGif = "gif"
+   97 showPreset Quick      = "quick"
+   98 showPreset MediumQ    = "medium"
+   99 showPreset HighQ      = "high"
+  100 showPreset LowFPS     = "lowfps"
+  101 
+  102 options :: Parser Options
+  103 options = Options <$> commandP
+  104 
+  105 commandP :: Parser Command
+  106 commandP = subparser(
+  107      command "test" testCommand
+  108   <> commandGroup "Internal commands"
+  109   <> internal )
+  110   <|> hsubparser
+  111     ( command "check" checkCommand
+  112     <> command "view" viewCommand
+  113     <> command "render" renderCommand
+  114     <> command "raw" rawCommand
+  115     )
+  116   <|> infoParser viewCommand
+  117 
+  118 rawCommand :: ParserInfo Command
+  119 rawCommand = info parse
+  120     (progDesc "Output raw SVGs for animation at 60 fps. Used internally by viewer.")
+  121   where
+  122     parse = Raw
+  123       <$> strOption
+  124         ( long "output" <>
+  125           short 'o' <>
+  126           metavar "PATH" <>
+  127           help "Output folder" <>
+  128           value ".")
+  129       <*> option auto
+  130         ( long "offset" <>
+  131           metavar "NUMBER" <>
+  132           help "Frame offset" <>
+  133           value 0)
+  134       <*> switch
+  135         ( long "pretty-print" <>
+  136           short 'p' <>
+  137           help "Pretty print svg")
+  138 
+  139 testCommand :: ParserInfo Command
+  140 testCommand = info (parse <**> helper)
+  141     (progDesc "Generate 10 frames spread out evenly across the animation. Used \
+  142               \internally by the test-suite.")
+  143   where
+  144     parse = pure Test
+  145 
+  146 checkCommand :: ParserInfo Command
+  147 checkCommand = info parse
+  148     (progDesc "Run a system's diagnostic and report any missing external dependencies.")
+  149   where
+  150     parse = pure Check
+  151 
+  152 viewCommand :: ParserInfo Command
+  153 viewCommand = info parse
+  154     (progDesc "Play animation in browser window.")
+  155   where
+  156     parse = View
+  157       <$> switch
+  158         (long "verbose" <> short 'v')
+  159       <*> optional (strOption (long "ghc"
+  160                     <> metavar "PATH"
+  161                     <> help "Path to GHC binary"))
+  162       <*> many (strOption (long "ghc-opt"
+  163                 <> short 'G'
+  164                 <> help "Additional option to pass to ghc"))
+  165       <*> optional (strOption (long "self"
+  166                     <> metavar "PATH"
+  167                     <> help "Source file used for live-reloading"))
+  168 
+  169 renderCommand :: ParserInfo Command
+  170 renderCommand = info parse
+  171     (progDesc "Render animation to file.")
+  172   where
+  173     -- fromPreset :: (Maybe Preset -> (Command -> Command))
+  174     -- fromPreset Nothing = id
+  175     -- fromPreset (Just ExampleGif) = \cmd -> cmd{renderFPS=24}
+  176     -- modParser :: Parser (Command -> Command)
+  177     -- modParser = fmap fromPreset $
+  178     --   optional (option (maybeReader readPreset)
+  179     --       (long "preset" <> showDefaultWith showPreset
+  180     --       <> metavar "TYPE"
+  181     --       <> help "Parameter presets: youtube, gif, quick"))
+  182     parse = Render
+  183       <$> optional (strOption (long "target"
+  184                     <> short 'o'
+  185                     <> metavar "FILE"
+  186                     <> help "Write output to FILE"))
+  187       <*> optional (option auto
+  188           (long "fps" <> metavar "FPS"
+  189           <> help "Set frames per second."))
+  190       <*> optional (option auto
+  191           (long "width" <> short 'w' <> metavar "PIXELS"
+  192           <> help "Set video width."))
+  193       <*> optional (option auto
+  194           (long "height" <> short 'h'
+  195           <> metavar "PIXELS" <> help "Set video height."))
+  196       <*> switch (long "compile"
+  197                   <> help "Compile source code before rendering.")
+  198       <*> optional (option (maybeReader readFormat)
+  199           (long "format" <> metavar "FMT"
+  200           <> help "Video format: mp4, gif, webm"))
+  201       <*> optional (option (maybeReader readPreset)
+  202           (long "preset" <> showDefaultWith showPreset
+  203           <> metavar "TYPE"
+  204           <> help "Parameter presets: youtube, gif, quick, medium, high"))
+  205       <*> option (maybeReader readRaster)
+  206           (long "raster" <> showDefaultWith showRaster
+  207           <> metavar "RASTER"
+  208           <> value RasterNone
+  209           <> help "Raster engine: none, auto, inkscape, rsvg, imagemagick")
+  210       <*> switch
+  211         (long "partial"
+  212         <> help "Produce partial animation even if frame generation was \
+  213                 \interrupted by ctrl-c")
+  214 
+  215 opts :: ParserInfo Options
+  216 opts = info (options <**> helper )
+  217   ( fullDesc
+  218   <> progDesc "This program contains an animation which can either be viewed \
+  219               \in a web-browser or rendered to disk."
+  220   )
+  221 
+  222 getDriverOptions :: IO Options
+  223 getDriverOptions = customExecParser (prefs showHelpOnError) opts
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Driver.Check.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Driver.Check.hs.html new file mode 100644 index 0000000..11d56c6 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Driver.Check.hs.html @@ -0,0 +1,229 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE ScopedTypeVariables #-}
+    2 module Reanimate.Driver.Check
+    3   ( checkEnvironment
+    4   , hasRSvg
+    5   , hasInkscape
+    6   , hasMagick
+    7   , hasFFmpegRSvg
+    8   ) where
+    9 
+   10 import           Control.Exception            (SomeException, handle)
+   11 import           Control.Monad
+   12 import           Data.Maybe
+   13 import           Data.Version
+   14 import           Reanimate.Misc               (runCmd_)
+   15 import           Reanimate.Driver.Magick      (magickCmd)
+   16 import           System.Console.ANSI.Codes
+   17 import           System.Directory             (findExecutable)
+   18 import           System.IO
+   19 import           System.IO.Temp
+   20 import           Text.ParserCombinators.ReadP
+   21 import           Text.Printf
+   22 
+   23 --------------------------------------------------------------------------
+   24 -- Check environment
+   25 
+   26 checkEnvironment :: IO ()
+   27 checkEnvironment = do
+   28     putStrLn "reanimate checks:"
+   29     runCheck "Has ffmpeg" hasFFmpeg
+   30     runCheck "Has ffmpeg(rsvg)" hasFFmpegRSvg
+   31     runCheck "Has dvisvgm" hasDvisvgm
+   32     runCheck "Has povray" hasPovray
+   33     runCheck "Has blender" hasBlender
+   34     runCheck "Has rsvg-convert" hasRSvg
+   35     runCheck "Has inkscape" hasInkscape
+   36     runCheck "Has imagemagick" hasMagick
+   37     runCheck "Has LaTeX" hasLaTeX
+   38     runCheck ("Has LaTeX package '"++ "babel" ++ "'") $ hasTeXPackage "latex"
+   39       "[english]{babel}"
+   40     forM_ latexPackages $ \pkg ->
+   41       runCheck ("Has LaTeX package '"++ pkg ++ "'") $ hasTeXPackage "latex" $
+   42         "{"++pkg++"}"
+   43     runCheck "Has XeLaTeX" hasXeLaTeX
+   44     forM_ xelatexPackages $ \pkg ->
+   45       runCheck ("Has XeLaTeX package '"++ pkg ++ "'") $ hasTeXPackage "xelatex" $
+   46         "{"++pkg++"}"
+   47   where
+   48     latexPackages =
+   49       ["preview"
+   50       ,"amsmath"
+   51       --,"amssymb"
+   52       --,"dsfont"
+   53       --,"setspace"
+   54       --,"relsize"
+   55       --,"textcomp"
+   56       --,"mathrsfs"
+   57       --,"calligra"
+   58       --,"wasysym"
+   59       --,"ragged2e"
+   60       --,"physics"
+   61       --,"xcolor"
+   62       --,"textcomp"
+   63       --,"xfrac"
+   64       --,"microtype"
+   65       ]
+   66     xelatexPackages =
+   67       ["ctex"]
+   68     runCheck msg fn = do
+   69       printf "  %-35s" (msg ++ ":")
+   70       val <- fn
+   71       case val of
+   72         Left err -> putStrLnColor Red err
+   73         Right ok -> putStrLnColor Green ok
+   74 
+   75 putStrLnColor :: Color -> String -> IO ()
+   76 putStrLnColor color msg =
+   77   putStrLn $ setSGRCode [SetColor Foreground Vivid color] ++ msg ++ setSGRCode [Reset]
+   78 
+   79 -- latex, dvisvgm, xelatex
+   80 
+   81 hasLaTeX :: IO (Either String String)
+   82 hasLaTeX = hasProgram "latex"
+   83 
+   84 hasXeLaTeX :: IO (Either String String)
+   85 hasXeLaTeX = hasProgram "xelatex"
+   86 
+   87 hasDvisvgm :: IO (Either String String)
+   88 hasDvisvgm = hasProgram "dvisvgm"
+   89 
+   90 hasPovray :: IO (Either String String)
+   91 hasPovray = hasProgram "povray"
+   92 
+   93 hasFFmpeg :: IO (Either String String)
+   94 hasFFmpeg = checkMinVersion minVersion <$> ffmpegVersion
+   95   where
+   96     minVersion = Version [4,1,3] []
+   97 
+   98 hasFFmpegRSvg :: IO (Either String String)
+   99 hasFFmpegRSvg = do
+  100   mbPath <- findExecutable "ffmpeg"
+  101   case mbPath of
+  102     Nothing -> return $ Left "n/a"
+  103     Just path -> do
+  104       ret <- runCmd_ path ["-version"]
+  105       pure $ case ret of
+  106         Right out | "--enable-librsvg" `elem` words out
+  107           -> Right "yes"
+  108         _ -> Left "no"
+  109 
+  110 hasBlender :: IO (Either String String)
+  111 hasBlender = checkMinVersion minVersion <$> blenderVersion
+  112   where
+  113     minVersion = Version [2,80] []
+  114 
+  115 hasRSvg :: IO (Either String String)
+  116 hasRSvg = checkMinVersion minVersion <$> rsvgVersion
+  117   where
+  118     minVersion = Version [2,44,0] []
+  119 
+  120 hasInkscape :: IO (Either String String)
+  121 hasInkscape = checkMinVersion minVersion <$> inkscapeVersion
+  122   where
+  123     minVersion = Version [0,92] []
+  124 
+  125 hasMagick :: IO (Either String String)
+  126 hasMagick = checkMinVersion minVersion <$> magickVersion
+  127   where
+  128     minVersion = Version [6,0,0] []
+  129 
+  130 ffmpegVersion :: IO (Maybe Version)
+  131 ffmpegVersion = extractVersion "ffmpeg" ["-version"] $ \line ->
+  132       case take 3 $ words line of
+  133         ["ffmpeg", "version", vs] -> vs
+  134         _                         -> ""
+  135 
+  136 blenderVersion :: IO (Maybe Version)
+  137 blenderVersion = extractVersion "blender" ["--version"] $ \line ->
+  138     case take 2 (words line) of
+  139       ["Blender", vs] -> vs
+  140       _               -> ""
+  141 
+  142 rsvgVersion :: IO (Maybe Version)
+  143 rsvgVersion = extractVersion "rsvg-convert" ["--version"] $ \line ->
+  144   case words line of
+  145     ["rsvg-convert", "version", vs] -> vs
+  146     _                               -> ""
+  147 
+  148 inkscapeVersion :: IO (Maybe Version)
+  149 inkscapeVersion = extractVersion "inkscape" ["--version"] $ \line ->
+  150     case take 2 $ words line of
+  151       ["Inkscape", vs] -> vs
+  152       _                -> ""
+  153 
+  154 magickVersion :: IO (Maybe Version)
+  155 magickVersion = extractVersion magickCmd ["-version"] $ \line ->
+  156     case take 3 $ words line of
+  157       ["Version:", "ImageMagick", vs] -> vs
+  158       _                               -> ""
+  159 
+  160 checkMinVersion :: Version -> Maybe Version -> Either String String
+  161 checkMinVersion _minVersion Nothing = Left "no"
+  162 checkMinVersion minVersion (Just vs)
+  163   | vs < minVersion = Left $ "too old: " ++ showVersion vs ++ " < " ++ showVersion minVersion
+  164   | otherwise       = Right (showVersion vs)
+  165 
+  166 extractVersion :: FilePath -> [String] -> (String -> String) -> IO (Maybe Version)
+  167 extractVersion execPath args outputFilter = do
+  168   mbPath <- findExecutable execPath
+  169   case mbPath of
+  170     Nothing -> return Nothing
+  171     Just path -> do
+  172       ret <- runCmd_ path args
+  173       case ret of
+  174         Left{} -> return $ Just noVersion
+  175         Right out ->
+  176           pure $ Just $ fromMaybe noVersion $ parseVS $ outputFilter out
+  177   where
+  178     noVersion = Version [] []
+  179     parseVS vs = listToMaybe $ reverse
+  180       [ v | (v, _) <- readP_to_S parseVersion vs ]
+  181 
+  182 hasTeXPackage :: FilePath -> String -> IO (Either String String)
+  183 hasTeXPackage exec pkg = handle (\(_::SomeException) -> return $ Left "n/a") $
+  184     withSystemTempDirectory "reanimate" $ \tmp_dir -> withTempFile tmp_dir "test.tex" $ \tex_file tex_handle -> do
+  185       hPutStr tex_handle tex_document
+  186       hPutStr tex_handle $ "\\usepackage" ++ pkg ++ "\n"
+  187       hPutStr tex_handle "\\begin{document}\n"
+  188       hPutStr tex_handle "blah\n"
+  189       hPutStr tex_handle tex_epilogue
+  190       hClose tex_handle
+  191       ret <- runCmd_ exec ["-interaction=batchmode", "-halt-on-error", "-output-directory="++tmp_dir, tex_file]
+  192       return $ case ret of
+  193         Right{} -> Right "OK"
+  194         Left{}  -> Left "missing"
+  195   where
+  196     tex_document = "\\documentclass[preview]{standalone}\n"
+  197     tex_epilogue =
+  198       "\n\
+  199       \\\end{document}"
+  200 
+  201 hasProgram :: String -> IO (Either String String)
+  202 hasProgram exec = do
+  203   mbPath <- findExecutable exec
+  204   return $ case mbPath of
+  205     Nothing   -> Left $ "'" ++ exec ++ "' not found"
+  206     Just path -> Right path
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Driver.Compile.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Driver.Compile.hs.html new file mode 100644 index 0000000..131765a --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Driver.Compile.hs.html @@ -0,0 +1,58 @@ + + + + + + +
+never executed always true always false
+
+
+    1 module Reanimate.Driver.Compile ( compile ) where
+    2 
+    3 import           Reanimate.Driver.Server (findOwnSource)
+    4 import           System.Directory
+    5 import           System.Exit
+    6 import           System.FilePath
+    7 import           System.Process
+    8 import           System.IO
+    9 
+   10 compile :: [String] -> IO ()
+   11 compile opts = do
+   12   mbSelf <- findOwnSource
+   13   case mbSelf of
+   14     Nothing -> do
+   15       hPutStrLn stderr
+   16         "Failed to find source code. Did you already compile the animations?\n\
+   17         \Try running again without the --compile flag."
+   18       exitFailure
+   19     Just self -> do
+   20       let selfDir = takeDirectory self
+   21           selfName = takeBaseName self
+   22           outDir = selfDir </> ".reanimate" </> selfName
+   23           target = outDir </> selfName
+   24           ghcOptions =
+   25               ["-rtsopts", "--make", "-threaded", "-O2"] ++
+   26               ["-odir", outDir, "-hidir", outDir] ++
+   27               [self, "-o", target]
+   28       createDirectoryIfMissing True outDir
+   29       withCurrentDirectory selfDir $ do
+   30         checkExitCode =<< rawSystem "stack" (["ghc", "--"] ++ ghcOptions)
+   31         checkExitCode =<< rawSystem target opts
+   32 
+   33 checkExitCode :: ExitCode -> IO ()
+   34 checkExitCode ExitSuccess     = return ()
+   35 checkExitCode (ExitFailure n) = exitWith (ExitFailure n)
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Driver.Magick.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Driver.Magick.hs.html new file mode 100644 index 0000000..e675f72 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Driver.Magick.hs.html @@ -0,0 +1,41 @@ + + + + + + +
+never executed always true always false
+
+
+    1 module Reanimate.Driver.Magick
+    2   ( magickCmd
+    3   ) where
+    4 
+    5 import System.IO.Unsafe (unsafePerformIO)
+    6 import System.Directory (findExecutable)
+    7 
+    8 -- |The name of the ImageMagick command. On Unix-like operating systems, the
+    9 -- command \'convert\' does not conflict with the name of other commands. On
+   10 -- Windows, ImageMagick version 7 is readily available, the command \'magick\'
+   11 -- should be present, and is preferred over \'convert\'. If it is not present,
+   12 -- \'convert\' is assumed to be the relevant command.
+   13 magickCmd :: String
+   14 -- The use of 'unsafeperformIO' is justified on the basis that if \'magick\' is
+   15 -- found once, it will always be present.
+   16 magickCmd = unsafePerformIO $ do
+   17   mPath <- findExecutable "magick"
+   18   pure $ maybe "convert" (const "magick") mPath
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Driver.Server.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Driver.Server.hs.html new file mode 100644 index 0000000..b319148 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Driver.Server.hs.html @@ -0,0 +1,321 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE OverloadedStrings   #-}
+    2 {-# LANGUAGE ScopedTypeVariables #-}
+    3 module Reanimate.Driver.Server
+    4   ( serve
+    5   , findOwnSource
+    6   ) where
+    7 
+    8 import           Control.Concurrent
+    9 import           Control.Exception      (SomeException, catch, finally)
+   10 import           Control.Monad
+   11 import           Data.IORef
+   12 import           Data.Text              (Text)
+   13 import qualified Data.Text              as T
+   14 import qualified Data.Text.Read         as T
+   15 import           Data.Time
+   16 import           GHC.Environment        (getFullArgs)
+   17 import           Language.Haskell.Ghcid
+   18 import           Network.WebSockets
+   19 import           Paths_reanimate
+   20 import           Reanimate.Misc         (runCmdLazy, runCmd_)
+   21 import           System.Directory       (createDirectoryIfMissing,
+   22                                          doesFileExist, findFile, listDirectory,
+   23                                          makeAbsolute,
+   24                                          withCurrentDirectory)
+   25 import           System.Environment     (getProgName)
+   26 import           System.Exit
+   27 import           System.FilePath
+   28 import           System.FSNotify
+   29 import           System.IO
+   30 import           System.IO.Temp
+   31 import           System.Process
+   32 import           Web.Browser            (openBrowser)
+   33 
+   34 opts :: ConnectionOptions
+   35 opts = defaultConnectionOptions
+   36   { connectionCompressionOptions = PermessageDeflateCompression defaultPermessageDeflate }
+   37 
+   38 serve :: Bool -> Maybe FilePath -> [String] -> Maybe FilePath -> IO ()
+   39 serve verbose mbGHCPath extraGHCOpts mbSelfPath = withManager $ \watch -> do
+   40   hSetBuffering stdin NoBuffering
+   41   self <- maybe requireOwnSource pure mbSelfPath
+   42   when verbose $
+   43     logMsg $ "Found own source code at: " ++ self
+   44   hasConnectionVar <- newMVar False
+   45 
+   46   ghci <- ghciBackend mbGHCPath self
+   47 
+   48   -- There might already browser window open. Wait 2s to see if that window
+   49   -- connects to us. If not, open a new window.
+   50   _ <- forkIO $ do
+   51     threadDelay (2*10^(6::Int))
+   52     hasConn <- readMVar hasConnectionVar
+   53     unless hasConn openViewer
+   54   logMsg "Listening..."
+   55   let options = ServerOptions
+   56         { serverHost = "127.0.0.1"
+   57         , serverPort = 9161
+   58         , serverConnectionOptions = opts
+   59         , serverRequirePong = Nothing }
+   60   withSystemTempDirectory "reanimate-svgs" $ \tmpDir ->
+   61     runServerWithOptions options $ \pending -> do
+   62       logMsg "New connection received."
+   63       hasConn <- swapMVar hasConnectionVar True
+   64       if hasConn
+   65         then do
+   66           logMsg "Already connected to browser. Rejecting."
+   67           rejectRequestWith pending defaultRejectRequest
+   68         else do
+   69           createDirectoryIfMissing True tmpDir
+   70           conn <- acceptRequest pending
+   71           slave <- newEmptyMVar
+   72           let handler = modifyMVar_ slave $ \tid -> do
+   73                 logMsg "Reloading code..."
+   74                 killThread tid
+   75                 forkIO $ ignoreErrors $ slaveHandler verbose mbGHCPath extraGHCOpts conn ghci self tmpDir
+   76               killSlave = do
+   77                 tid <- takeMVar slave
+   78                 killThread tid
+   79           stop <- watchFile watch self handler
+   80           putMVar slave =<< forkIO (return ())
+   81           handler
+   82           let loop = do
+   83                 -- FIXME: We don't use msg here.
+   84                 _msg <- receiveData conn :: IO T.Text
+   85                 handler
+   86                 loop
+   87               cleanup = do
+   88                 stop
+   89                 killSlave
+   90                 _ <- swapMVar hasConnectionVar False
+   91                 return ()
+   92           loop `finally` cleanup
+   93 
+   94 ignoreErrors :: IO () -> IO ()
+   95 ignoreErrors action = action `catch` \(_::SomeException) -> return ()
+   96 
+   97 openViewer :: IO ()
+   98 openViewer = do
+   99   url <- getDataFileName "viewer-elm/dist/index.html"
+  100   logMsg "Opening browser..."
+  101   bSucc <- openBrowser url
+  102   if bSucc
+  103       then logMsg "Browser opened."
+  104       else hPutStrLn stderr $ "Failed to open browser. Manually visit: " ++ url
+  105 
+  106 slaveHandler :: Bool -> Maybe FilePath -> [String] -> Connection -> GhciBackend
+  107              -> FilePath -> FilePath -> IO ()
+  108 slaveHandler verbose mbGHCPath extraGHCOpts conn ghci self svgDir =
+  109   withCurrentDirectory (takeDirectory self) $
+  110   withSystemTempDirectory "reanimate" $ \tmpDir ->
+  111   withTempFile tmpDir "reanimate.exe" $ \tmpExecutable handle -> do
+  112     outputFolder <- createTempDirectory svgDir "svgs"
+  113     let frameFileName frameIdx =
+  114           outputFolder </> show frameIdx <.> "svg"
+  115 
+  116     sentFrameCount <- newMVar False
+  117     hClose handle
+  118     lock <- newMVar ()
+  119     sendWebMessage conn $ WebStatus "Compiling"
+  120     ghciThread <- forkIO $ do
+  121       firstFrame <- newIORef True
+  122       ghciReload ghci
+  123       logMsg "GHCi reload done."
+  124       ghciGenerate ghci outputFolder $ \frameIdx -> do
+  125         first <- readIORef firstFrame
+  126         writeIORef firstFrame False
+  127         if first
+  128           then do
+  129             modifyMVar_ sentFrameCount $ \sent -> do
+  130               unless sent $
+  131                 sendWebMessage conn $ WebFrameCount frameIdx
+  132               logMsg "Framecount sent."
+  133               return True
+  134           else
+  135             withMVar lock $ \_ ->
+  136               sendWebMessage conn $ WebFrame frameIdx (frameFileName frameIdx)
+  137       logMsg "GHCi render done."
+  138     ret <- case mbGHCPath of
+  139       Nothing -> do
+  140         let args = ["ghc", "--"] ++ ghcOptions tmpDir ++ extraGHCOpts ++ [takeFileName self, "-o", tmpExecutable]
+  141         when verbose $
+  142           logMsg $ "Running: " ++ showCommandForUser "stack" args
+  143         runCmd_ "stack" args
+  144       Just ghc -> do
+  145         let args = ghcOptions tmpDir ++ extraGHCOpts ++ [takeFileName self, "-o", tmpExecutable]
+  146         when verbose $
+  147           logMsg $ "Running: " ++ showCommandForUser ghc args
+  148         runCmd_ ghc args
+  149     logMsg "Compile done."
+  150     case ret of
+  151       Left err ->
+  152         sendWebMessage conn $ WebError $ unlines (lines err)
+  153       Right{} -> runCmdLazy tmpExecutable (execOpts outputFolder) $ \getFrame -> do
+  154         frameCount <- expectFrame =<< getFrame
+  155         modifyMVar_ sentFrameCount $ \sent -> do
+  156           unless sent $
+  157             sendWebMessage conn $ WebFrameCount frameCount
+  158           return True
+  159         replicateM_ frameCount $ do
+  160           frameIdx <- expectFrame =<< getFrame
+  161           withMVar lock $ \_ ->
+  162             sendWebMessage conn $ WebFrame frameIdx (frameFileName frameIdx)
+  163         logMsg "Optimized render done."
+  164         killThread ghciThread
+  165   where
+  166     execOpts output =
+  167       [ "raw", "--output", output, "--offset", "1"
+  168       , "+RTS", "-N", "-M2G", "-RTS"]
+  169     expectFrame :: Either String Text -> IO Int
+  170     expectFrame (Left "") = do
+  171       sendWebMessage conn $ WebStatus "Done"
+  172       exitSuccess
+  173     expectFrame (Left err) = do
+  174       sendWebMessage conn $ WebError err
+  175       exitWith (ExitFailure 1)
+  176     expectFrame (Right frame) =
+  177       case T.decimal frame of
+  178         Left err -> do
+  179           hPutStrLn stderr (T.unpack frame)
+  180           hPutStrLn stderr $ "expectFrame: " ++ err
+  181           sendWebMessage conn $ WebError err
+  182           exitWith (ExitFailure 1)
+  183         Right (frameNumber, "") ->
+  184           pure frameNumber
+  185         Right {} -> do
+  186           let err = "Unexpected output"
+  187           hPutStrLn stderr (T.unpack frame)
+  188           hPutStrLn stderr $ "expectFrame: " ++ err
+  189           sendWebMessage conn $ WebError err
+  190           exitWith (ExitFailure 1)
+  191 
+  192 watchFile :: WatchManager -> FilePath -> IO () -> IO StopListening
+  193 watchFile watch file action = watchTree watch (takeDirectory file) check (const action)
+  194   where
+  195     check event =
+  196       takeFileName (eventPath event) == takeFileName file ||
+  197       takeExtension (eventPath event) `elem` sourceExtensions ||
+  198       takeExtension (eventPath event) `elem` dataExtensions
+  199     sourceExtensions = [".hs", ".lhs"]
+  200     dataExtensions = [".jpg", ".png", ".bmp", ".pov", ".tex", ".csv"]
+  201 
+  202 ghcOptions :: FilePath -> [String]
+  203 ghcOptions tmpDir =
+  204     ["-rtsopts", "--make", "-threaded", "-O2"] ++
+  205     ["-odir", tmpDir, "-hidir", tmpDir]
+  206 
+  207 -- FIXME: Move to a different module
+  208 requireOwnSource :: IO FilePath
+  209 requireOwnSource = do
+  210   mbSelf <- findOwnSource
+  211   case mbSelf of
+  212     Nothing -> do
+  213       hPutStrLn stderr
+  214         "Rendering in browser window is only available when interpreting.\n\
+  215         \To render a video file, use the 'render' command or run again with --help\n\
+  216         \to see all available options."
+  217       exitFailure
+  218     Just self -> pure self
+  219 
+  220 findOwnSource :: IO (Maybe FilePath)
+  221 findOwnSource = do
+  222   fullArgs <- getFullArgs
+  223   stackSource <- makeAbsolute (last fullArgs)
+  224   exist <- doesFileExist stackSource
+  225   if exist && isHaskellFile stackSource
+  226     then return (Just stackSource)
+  227     else do
+  228       prog <- getProgName
+  229       let hsProg
+  230             | isHaskellFile prog = prog
+  231             | otherwise = replaceExtension prog "hs"
+  232       lst <- listDirectory "."
+  233       findFile ("." : lst) hsProg
+  234 
+  235 isHaskellFile :: FilePath -> Bool
+  236 isHaskellFile path = takeExtension path `elem` [".hs", ".lhs"]
+  237 
+  238 logMsg :: String -> IO ()
+  239 logMsg msg = do
+  240     now <- getCurrentTime
+  241     putStrLn $ formatTime defaultTimeLocale fmt now ++ ": " ++ msg
+  242   where
+  243     fmt = "%F %T%2Q"
+  244 
+  245 -------------------------------------------------------------------------------
+  246 -- Ghci interface
+  247 
+  248 -- stack
+  249 -- cabal
+  250 -- raw
+  251 -- none?
+  252 data GhciBackend = GhciBackend (MVar Ghci)
+  253 
+  254 ghciBackend :: Maybe FilePath -> FilePath -> IO GhciBackend
+  255 ghciBackend mbGHCPath self = do
+  256   let ghciProc =
+  257         case mbGHCPath of
+  258           Just ghcPath ->
+  259             proc ghcPath $ ["--interactive", "+RTS"] ++ words memoryLimit ++ ["-RTS"]
+  260           Nothing ->
+  261             proc "stack" ["exec", "ghci", "--rts-options="++memoryLimit]
+  262   (ghci, _loads) <- startGhciProcess ghciProc $ \_stream _msg -> return ()
+  263   void $ exec ghci $ ":load " ++ self
+  264   ref <- newMVar ghci
+  265   return $ GhciBackend ref
+  266 
+  267 ghciReload :: GhciBackend -> IO ()
+  268 ghciReload (GhciBackend ref) =
+  269   withMVar ref $ \ghci ->
+  270     void $ reload ghci
+  271 
+  272 ghciGenerate :: GhciBackend -> FilePath -> (Int -> IO ()) -> IO ()
+  273 ghciGenerate (GhciBackend ref) target cb = withMVar ref $ \ghci -> do
+  274   execStream ghci (":main raw --output=" ++ target ++ " --offset=1")
+  275     $ \_ msg ->
+  276       case reads msg of
+  277         [(frameIdx,"")] -> cb frameIdx
+  278         _               -> return ()
+  279 
+  280 memoryLimit :: String
+  281 memoryLimit = "-M1G"
+  282 
+  283 -------------------------------------------------------------------------------
+  284 -- Websocket API
+  285 
+  286 data WebMessage
+  287   = WebStatus String
+  288   | WebError String
+  289   | WebFrameCount Int
+  290   | WebFrame Int FilePath
+  291 
+  292 sendWebMessage :: Connection -> WebMessage -> IO ()
+  293 sendWebMessage conn msg = sendTextData conn $
+  294   case msg of
+  295     WebStatus txt   -> T.pack "status\n" <> T.pack txt
+  296     WebError txt    -> T.pack "error\n" <> T.pack txt
+  297     WebFrameCount n -> T.pack $ "frame_count\n" ++ show n
+  298     WebFrame n path -> T.pack $ "frame\n" ++ show n ++ "\n" ++ path
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Driver.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Driver.hs.html new file mode 100644 index 0000000..f369f3e --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Driver.hs.html @@ -0,0 +1,246 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE MultiWayIf      #-}
+    2 {-# LANGUAGE RecordWildCards #-}
+    3 module Reanimate.Driver
+    4   ( reanimate
+    5   )
+    6 where
+    7 
+    8 import           Control.Applicative      ((<|>))
+    9 import           Control.Monad
+   10 import           Data.Maybe
+   11 import           Data.Either
+   12 import           Reanimate.Animation      (Animation)
+   13 import           Reanimate.Driver.Check
+   14 import           Reanimate.Driver.CLI
+   15 import           Reanimate.Driver.Compile
+   16 import           Reanimate.Driver.Server
+   17 import           Reanimate.Parameters
+   18 import           Reanimate.Render         (render, renderSnippets, renderSvgs,
+   19                                            selectRaster)
+   20 import           System.Directory
+   21 import           System.Exit
+   22 import           System.FilePath
+   23 import           System.IO
+   24 import           Text.Printf
+   25 
+   26 presetFormat :: Preset -> Format
+   27 presetFormat Youtube    = RenderMp4
+   28 presetFormat ExampleGif = RenderGif
+   29 presetFormat Quick      = RenderMp4
+   30 presetFormat MediumQ    = RenderMp4
+   31 presetFormat HighQ      = RenderMp4
+   32 presetFormat LowFPS     = RenderMp4
+   33 
+   34 presetFPS :: Preset -> FPS
+   35 presetFPS Youtube    = 60
+   36 presetFPS ExampleGif = 25
+   37 presetFPS Quick      = 15
+   38 presetFPS MediumQ    = 30
+   39 presetFPS HighQ      = 30
+   40 presetFPS LowFPS     = 10
+   41 
+   42 presetWidth :: Preset -> Width
+   43 presetWidth Youtube    = 2560
+   44 presetWidth ExampleGif = 320
+   45 presetWidth Quick      = 320
+   46 presetWidth MediumQ    = 800
+   47 presetWidth HighQ      = 1920
+   48 presetWidth LowFPS     = presetWidth HighQ
+   49 
+   50 presetHeight :: Preset -> Height
+   51 presetHeight preset = presetWidth preset * 9 `div` 16
+   52 
+   53 formatFPS :: Format -> FPS
+   54 formatFPS RenderMp4  = 60
+   55 formatFPS RenderGif  = 25
+   56 formatFPS RenderWebm = 60
+   57 
+   58 formatWidth :: Format -> Width
+   59 formatWidth RenderMp4  = 2560
+   60 formatWidth RenderGif  = 320
+   61 formatWidth RenderWebm = 2560
+   62 
+   63 formatHeight :: Format -> Height
+   64 formatHeight RenderMp4  = 1440
+   65 formatHeight RenderGif  = 180
+   66 formatHeight RenderWebm = 1440
+   67 
+   68 formatExtension :: Format -> String
+   69 formatExtension RenderMp4  = "mp4"
+   70 formatExtension RenderGif  = "gif"
+   71 formatExtension RenderWebm = "webm"
+   72 
+   73 {-|
+   74 Main entry-point for accessing an animation. Creates a program that takes the
+   75 following command-line arguments:
+   76 
+   77 > Usage: PROG [COMMAND]
+   78 >   This program contains an animation which can either be viewed in a web-browser
+   79 >   or rendered to disk.
+   80 >
+   81 > Available options:
+   82 >   -h,--help                Show this help text
+   83 >
+   84 > Available commands:
+   85 >   check                    Run a system's diagnostic and report any missing
+   86 >                            external dependencies.
+   87 >   view                     Play animation in browser window.
+   88 >   render                   Render animation to file.
+   89 
+   90 Neither the \'check\' nor the \'view\' command take any additional arguments.
+   91 Rendering animation can be controlled with these arguments:
+   92 
+   93 > Usage: PROG render [-o|--target FILE] [--fps FPS] [-w|--width PIXELS]
+   94 >                    [-h|--height PIXELS] [--compile] [--format FMT]
+   95 >                    [--preset TYPE]
+   96 >   Render animation to file.
+   97 >
+   98 > Available options:
+   99 >   -o,--target FILE         Write output to FILE
+  100 >   --fps FPS                Set frames per second.
+  101 >   -w,--width PIXELS        Set video width.
+  102 >   -h,--height PIXELS       Set video height.
+  103 >   --compile                Compile source code before rendering.
+  104 >   --format FMT             Video format: mp4, gif, webm
+  105 >   --preset TYPE            Parameter presets: youtube, gif, quick
+  106 >   -h,--help                Show this help text
+  107 -}
+  108 reanimate :: Animation -> IO ()
+  109 reanimate animation = do
+  110   Options {..} <- getDriverOptions
+  111   case optsCommand of
+  112     Raw {..} -> do
+  113       setFPS 60
+  114       renderSvgs rawOutputFolder rawFrameOffset rawPrettyPrint animation
+  115     Test -> do
+  116       setNoExternals True
+  117       -- hSetBinaryMode stdout True
+  118       renderSnippets animation
+  119     Check       -> checkEnvironment
+  120     View {..}   -> serve viewVerbose viewGHCPath viewGHCOpts viewOrigin
+  121     Render {..} -> do
+  122       let fmt =
+  123             guessParameter renderFormat (fmap presetFormat renderPreset)
+  124               $ case renderTarget of
+  125                   -- Format guessed from output
+  126                   Just target -> case takeExtension target of
+  127                     ".mp4"  -> RenderMp4
+  128                     ".gif"  -> RenderGif
+  129                     ".webm" -> RenderWebm
+  130                     _       -> RenderMp4
+  131                   -- Default to mp4 rendering.
+  132                   Nothing -> RenderMp4
+  133 
+  134       target <- case renderTarget of
+  135         Nothing -> do
+  136           mbSelf <- findOwnSource
+  137           let ext = formatExtension fmt
+  138               self = fromMaybe "output" mbSelf
+  139           pure $ replaceExtension self ext
+  140         Just target -> makeAbsolute target
+  141 
+  142       let
+  143         fps =
+  144           guessParameter renderFPS (fmap presetFPS renderPreset) $ formatFPS fmt
+  145         (width, height) = fromMaybe
+  146           ( maybe (formatWidth fmt)  presetWidth  renderPreset
+  147           , maybe (formatHeight fmt) presetHeight renderPreset
+  148           )
+  149           (userPreferredDimensions renderWidth renderHeight)
+  150 
+  151       raster <-
+  152         if renderRaster == RasterNone || renderRaster == RasterAuto  then do
+  153           svgSupport <- hasFFmpegRSvg
+  154           if isRight svgSupport
+  155             then selectRaster renderRaster
+  156             else do
+  157               raster <- selectRaster RasterAuto
+  158               when (raster == RasterNone) $ do
+  159                 hPutStrLn stderr $
+  160                   "Error: your FFmpeg was built without SVG support and no raster engines \
+  161                   \are available. Please install either inkscape, imagemagick, or rsvg."
+  162                 exitWith (ExitFailure 1)
+  163               return raster
+  164         else selectRaster renderRaster
+  165 
+  166       if renderCompile
+  167         then compile $
+  168           [ "render"
+  169           , "--fps"
+  170           , show fps
+  171           , "--width"
+  172           , show width
+  173           , "--height"
+  174           , show height
+  175           , "--format"
+  176           , showFormat fmt
+  177           , "--raster"
+  178           , showRaster raster
+  179           , "--target"
+  180           , target
+  181           , "+RTS"
+  182           , "-N"
+  183           , "-RTS"
+  184           ] ++ [ "--partial" | renderPartial ]
+  185         else do
+  186           setRaster raster
+  187           setFPS fps
+  188           setWidth width
+  189           setHeight height
+  190           printf
+  191             "Animation options:\n\
+  192                  \  fps:    %d\n\
+  193                  \  width:  %d\n\
+  194                  \  height: %d\n\
+  195                  \  fmt:    %s\n\
+  196                  \  target: %s\n\
+  197                  \  raster: %s\n"
+  198             fps
+  199             width
+  200             height
+  201             (showFormat fmt)
+  202             target
+  203             (show raster)
+  204 
+  205           render animation target raster fmt width height fps renderPartial
+  206 
+  207 guessParameter :: Maybe a -> Maybe a -> a -> a
+  208 guessParameter a b def = fromMaybe def (a <|> b)
+  209 
+  210 
+  211 -- If user specifies exactly one dimension explicitly, calculate the other
+  212 userPreferredDimensions :: Maybe Width -> Maybe Height -> Maybe (Width, Height)
+  213 userPreferredDimensions (Just width) (Just height) = Just (width, height)
+  214 userPreferredDimensions (Just width) Nothing =
+  215   Just (width, makeEven $ width * 9 `div` 16)
+  216 userPreferredDimensions Nothing (Just height) =
+  217   Just (makeEven $ height * 16 `div` 9, height)
+  218 userPreferredDimensions Nothing Nothing = Nothing
+  219 
+  220 -- Avoid ffmpeg failures "height not divisible by 2"
+  221 makeEven :: Int -> Int
+  222 makeEven x | even x    = x
+  223            | otherwise = x - 1
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Ease.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Ease.hs.html new file mode 100644 index 0000000..c2dcb40 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Ease.hs.html @@ -0,0 +1,131 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-|
+    2   Easing functions modify the rate of change in animations.
+    3   More examples can be seen here: <https://easings.net/>.
+    4 -}
+    5 module Reanimate.Ease
+    6   ( Signal
+    7   , constantS
+    8   , fromToS
+    9   , reverseS
+   10   , curveS
+   11   , powerS
+   12   , bellS
+   13   , oscillateS
+   14   , cubicBezierS
+   15   ) where
+   16 
+   17 -- | Signals are time-varying variables. Signals can be composed using function
+   18 --   composition.
+   19 type Signal = Double -> Double
+   20 
+   21 -- | Constant signal.
+   22 --
+   23 --   Example:
+   24 --
+   25 --   > signalA (constantS 0.5) drawProgress
+   26 --
+   27 --   <<docs/gifs/doc_constantS.gif>>
+   28 constantS :: Double -> Signal
+   29 constantS = const
+   30 
+   31 -- | Signal with new starting and end values.
+   32 --
+   33 --   Example:
+   34 --
+   35 --   > signalA (fromToS 0.8 0.2) drawProgress
+   36 --
+   37 --   <<docs/gifs/doc_fromToS.gif>>
+   38 fromToS :: Double -> Double -> Signal
+   39 fromToS from to t = from + (to-from)*t
+   40 
+   41 -- | Reverse signal order.
+   42 --
+   43 --   Example:
+   44 --
+   45 --   > signalA reverseS drawProgress
+   46 --
+   47 --   <<docs/gifs/doc_reverseS.gif>>
+   48 reverseS :: Signal
+   49 reverseS t = 1-t
+   50 
+   51 -- | S-curve signal. Takes a steepness parameter. 2 is a good default.
+   52 --
+   53 --   Example:
+   54 --
+   55 --   > signalA (curveS 2) drawProgress
+   56 --
+   57 --   <<docs/gifs/doc_curveS.gif>>
+   58 curveS :: Double -> Signal
+   59 curveS steepness s =
+   60   if s < 0.5
+   61     then 0.5 * (2*s)**steepness
+   62     else 1-0.5 * (2 - 2*s)**steepness
+   63 
+   64 -- | Power curve signal. Takes a steepness parameter. 2 is a good default.
+   65 --
+   66 --   Example:
+   67 --
+   68 --   > signalA (powerS 2) drawProgress
+   69 --
+   70 --   <<docs/gifs/doc_powerS.gif>>
+   71 powerS :: Double -> Signal
+   72 powerS steepness s = s**steepness
+   73 
+   74 -- | Oscillate signal.
+   75 --
+   76 --   Example:
+   77 --
+   78 --   > signalA oscillateS drawProgress
+   79 --
+   80 --   <<docs/gifs/doc_oscillateS.gif>>
+   81 oscillateS :: Signal
+   82 oscillateS t =
+   83   if t < 1/2
+   84     then t*2
+   85     else 2-t*2
+   86 
+   87 -- | Bell-curve signal. Takes a steepness parameter. 2 is a good default.
+   88 --
+   89 --   Example:
+   90 --
+   91 --   > signalA (bellS 2) drawProgress
+   92 --
+   93 --   <<docs/gifs/doc_bellS.gif>>
+   94 bellS :: Double -> Signal
+   95 bellS steepness = curveS steepness . oscillateS
+   96 
+   97 -- | Cubic Bezier signal. Gives you a fair amount of control over how the
+   98 --   signal will curve.
+   99 --
+  100 --   Example:
+  101 --
+  102 --   > signalA (cubicBezierS (0.0, 0.8, 0.9, 1.0)) drawProgress
+  103 --   
+  104 --   <<docs/gifs/doc_cubicBezierS.gif>>
+  105 cubicBezierS :: (Double, Double, Double, Double) -> Signal
+  106 cubicBezierS (x1, x2, x3, x4) s = 
+  107   let ms = 1-s
+  108   in x1*ms^(3::Int) + 3*x2*ms^(2::Int)*s + 3*x3*ms*s^(2::Int) + x4*s^(3::Int)
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Effect.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Effect.hs.html new file mode 100644 index 0000000..be63805 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Effect.hs.html @@ -0,0 +1,154 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-| Effects represent modifications applied to frames of the 'Animation'.
+    2 Effects can (and usually do) depend on time.
+    3 One or more effects can be applied over the entire duration of animation, or modified to affect
+    4 only a specific portion at the beginning \/ middle \/ end of the animation.
+    5 -}
+    6 module Reanimate.Effect
+    7   ( -- * Primitive Effects
+    8   Effect
+    9   , fadeInE
+   10   , fadeOutE
+   11   , fadeLineInE
+   12   , fadeLineOutE
+   13   , fillInE
+   14   , drawInE
+   15   , drawOutE
+   16   , translateE
+   17   , scaleE
+   18   , constE
+   19   -- * Modifying Effects
+   20   , overBeginning
+   21   , overEnding
+   22   , overInterval
+   23   , reverseE
+   24   , delayE
+   25   , aroundCenterE
+   26   -- * Applying Effects to Animations
+   27   , applyE
+   28   ) where
+   29 
+   30 import           Graphics.SvgTree    (Tree)
+   31 import           Reanimate.Animation
+   32 import           Reanimate.Svg
+   33 
+   34 -- | An Effect represents a modification of a SVG 'Tree' that can vary with time.
+   35 type Effect = Duration -- ^ Duration of the effect (in seconds)
+   36            -> Time -- ^ Time elapsed from when the effect started (in seconds)
+   37            -> Tree -- ^ Image to be modified
+   38            -> Tree -- ^ Image after modification
+   39 
+   40 -- | Modify the effect so that it only applies to the initial part of the animation.
+   41 overBeginning :: Duration -- ^ Duration of the initial segment of the animation over which the Effect should be applied
+   42               -> Effect -- ^ The Effect to modify
+   43               -> Effect -- ^ Effect which will only affect the initial segment of the animation
+   44 overBeginning maxT effect _d t =
+   45   if t < maxT
+   46     then effect maxT t
+   47     else id
+   48 
+   49 -- | Modify the effect so that it only applies to the ending part of the animation.
+   50 overEnding :: Duration -- ^ Duration of the ending segment of the animation over which the Effect should be applied
+   51            -> Effect  -- ^ The Effect to modify
+   52            -> Effect -- ^ Effect which will only affect the ending segment of the animation
+   53 overEnding minT effect d t =
+   54   if t >= blankDur
+   55     then effect minT (t-blankDur)
+   56     else id
+   57   where
+   58     blankDur = d-minT
+   59 
+   60 -- | Modify the effect so that it only applies within given interval of animation's running time.
+   61 overInterval :: Time -- ^ time after start of animation when the effect should start
+   62              -> Time -- ^ time after start of the animation when the effect should finish
+   63              -> Effect  -- ^ The Effect to modify
+   64              -> Effect -- ^ Effect which will only affect the specified interval within the animation
+   65 overInterval start end effect _d t =
+   66   if start <= t && t <= end
+   67     then effect dur ((t - start) / dur)
+   68     else id
+   69   where
+   70     dur = end - start
+   71 
+   72 -- | @reverseE effect@ starts where the @effect@ ends and vice versa.
+   73 reverseE :: Effect -> Effect
+   74 reverseE fn d t = fn d (d-t)
+   75 
+   76 -- | Delay the effect so that it only starts after specified duration and then runs till the end of animation.
+   77 delayE :: Duration -> Effect -> Effect
+   78 delayE delayT fn d = overEnding (d-delayT) fn d
+   79 
+   80 -- | Modify the animation by applying the effect. If desired, you can apply multiple effects to single animation by calling this function multiple times.
+   81 applyE :: Effect -> Animation -> Animation
+   82 applyE fn ani = let d = duration ani
+   83                 in mkAnimation d $ \t -> fn d (d*t) $ frameAt (d*t) ani
+   84 
+   85 -- | Build an effect from an image-modifying function. This effect does not change as time passes.
+   86 constE :: (Tree -> Tree) -> Effect
+   87 constE fn _d _t = fn
+   88 
+   89 -- | Change image opacity from 0 to 1.
+   90 fadeInE :: Effect
+   91 fadeInE d t = withGroupOpacity (t/d)
+   92 
+   93 -- | Change image opacity from 1 to 0. Reverse of 'fadeInE'.
+   94 fadeOutE :: Effect
+   95 fadeOutE = reverseE fadeInE
+   96 
+   97 -- | Change stroke width from 0 to given value.
+   98 fadeLineInE :: Double -> Effect
+   99 fadeLineInE w d t = withStrokeWidth (w*(t/d))
+  100 
+  101 -- | Change stroke width from given value to 0. Reverse of 'fadeLineInE'.
+  102 fadeLineOutE :: Double -> Effect
+  103 fadeLineOutE = reverseE . fadeLineInE
+  104 
+  105 -- | Effect of progressively drawing the image. Note that this will only affect primitive shapes (see 'pathify').
+  106 drawInE :: Effect
+  107 drawInE d t = withFillOpacity 0 . partialSvg (t/d) . pathify
+  108 
+  109 -- | Reverse of 'drawInE'.
+  110 drawOutE :: Effect
+  111 drawOutE = reverseE drawInE
+  112 
+  113 -- | Change fill opacity from 0 to 1.
+  114 fillInE :: Effect
+  115 fillInE d t = withFillOpacity f
+  116   where
+  117     f = t/d
+  118 
+  119 -- | Change scale from 1 to given value.
+  120 scaleE :: Double -> Effect
+  121 scaleE target d t = scale (1 + (target-1) * t/d)
+  122 
+  123 -- | Move the image from its current position to the target x y coordinates.
+  124 translateE :: Double -> Double -> Effect
+  125 translateE x y d t = translate (x * t/d) (y * t/d)
+  126 
+  127 -- | Transform the effect so that the image passed to the effect's image-modifying
+  128 -- function has coordinates (0, 0) shifted to the center of its bounding box.
+  129 -- Also see 'aroundCenter'.
+  130 aroundCenterE :: Effect -> Effect
+  131 aroundCenterE e d t = aroundCenter (e d t)
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.LaTeX.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.LaTeX.hs.html new file mode 100644 index 0000000..1204688 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.LaTeX.hs.html @@ -0,0 +1,205 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE OverloadedStrings   #-}
+    2 {-# LANGUAGE ScopedTypeVariables #-}
+    3 {-|
+    4 Copyright   : Written by David Himmelstrup
+    5 License     : Unlicense
+    6 Maintainer  : lemmih@gmail.com
+    7 Stability   : experimental
+    8 Portability : POSIX
+    9 -}
+   10 module Reanimate.LaTeX
+   11   ( latex
+   12   , latexWithHeaders
+   13   , latexChunks
+   14   , xelatex
+   15   , xelatexWithHeaders
+   16   , ctex
+   17   , ctexWithHeaders
+   18   , latexAlign
+   19   )
+   20 where
+   21 
+   22 import qualified Data.ByteString               as B
+   23 import           Data.Text                                ( Text )
+   24 import qualified Data.Text                     as T
+   25 import qualified Data.Text.Encoding            as T
+   26 import           Graphics.SvgTree                         ( Tree(..)
+   27                                                           , parseSvgFile
+   28                                                           )
+   29 import           Reanimate.Cache
+   30 import           Reanimate.Misc
+   31 import           Reanimate.Svg
+   32 import           Reanimate.Parameters
+   33 import           System.FilePath                          ( replaceExtension
+   34                                                           , takeFileName
+   35                                                           , (</>)
+   36                                                           )
+   37 import           System.IO.Unsafe                         ( unsafePerformIO )
+   38 
+   39 -- | Invoke latex and import the result as an SVG object. SVG objects are
+   40 --   cached to improve performance.
+   41 --
+   42 --   Example:
+   43 --
+   44 --   > latex "$e^{i\\pi}+1=0$"
+   45 --
+   46 --   <<docs/gifs/doc_latex.gif>>
+   47 latex :: T.Text -> Tree
+   48 latex = latexWithHeaders []
+   49 
+   50 -- | Invoke latex with extra script headers.
+   51 latexWithHeaders :: [T.Text] -> T.Text -> Tree
+   52 latexWithHeaders = someTexWithHeaders "latex" "dvi" []
+   53 
+   54 someTexWithHeaders :: String -> String -> [String] -> [T.Text] -> T.Text -> Tree
+   55 someTexWithHeaders _exec _dvi _args _headers tex | pNoExternals = mkText tex
+   56 someTexWithHeaders exec dvi args headers tex =
+   57   (unsafePerformIO . (cacheMem . cacheDiskSvg) (latexToSVG dvi exec args))
+   58     script
+   59  where
+   60   script = mkTexScript exec args headers tex
+   61 
+   62 -- | Invoke latex and separate results.
+   63 latexChunks :: [T.Text] -> [Tree]
+   64 latexChunks chunks | pNoExternals = map mkText chunks
+   65 latexChunks chunks                = worker (svgGlyphs $ latex $ T.concat chunks) chunks
+   66  where
+   67   merge lst = mkGroup [ fmt svg | (fmt, _, svg) <- lst ]
+   68   worker [] [] = []
+   69   worker _ [] = error "latex chunk mismatch"
+   70   worker everything (x : xs) =
+   71     let width = length $ svgGlyphs (latex x)
+   72     in merge (take width everything) : worker (drop width everything) xs
+   73 
+   74 -- | Invoke xelatex and import the result as an SVG object. SVG objects are
+   75 --   cached to improve performance. Xelatex has support for non-western scripts.
+   76 xelatex :: Text -> Tree
+   77 xelatex = xelatexWithHeaders []
+   78 
+   79 -- | Invoke xelatex with extra script headers.
+   80 xelatexWithHeaders :: [T.Text] -> T.Text -> Tree
+   81 xelatexWithHeaders = someTexWithHeaders "xelatex" "xdv" ["-no-pdf"]
+   82 
+   83 -- | Invoke xelatex with "\usepackage[UTF8]{ctex}" and import the result as an
+   84 --   SVG object. SVG objects are cached to improve performance. Xelatex has
+   85 --   support for non-western scripts.
+   86 --
+   87 --   Example:
+   88 --
+   89 --   > ctex "中文"
+   90 --
+   91 --   <<docs/gifs/doc_ctex.gif>>
+   92 ctex :: T.Text -> Tree
+   93 ctex = ctexWithHeaders []
+   94 
+   95 -- | Invoke xelatex with extra script headers + ctex headers.
+   96 ctexWithHeaders :: [T.Text] -> T.Text -> Tree
+   97 ctexWithHeaders headers = xelatexWithHeaders ("\\usepackage[UTF8]{ctex}" : headers)
+   98 
+   99 -- | Invoke latex and import the result as an SVG object. SVG objects are
+  100 --   cached to improve performance. This wraps the TeX code in an 'align*'
+  101 --   context.
+  102 --
+  103 --   Example:
+  104 --
+  105 --   > latexAlign "R = \\frac{{\\Delta x}}{{kA}}"
+  106 --
+  107 --   <<docs/gifs/doc_latexAlign.gif>>
+  108 latexAlign :: Text -> Tree
+  109 latexAlign tex = latex $ T.unlines ["\\begin{align*}", tex, "\\end{align*}"]
+  110 
+  111 postprocess :: Tree -> Tree
+  112 postprocess = simplify
+  113 
+  114 -- executable, arguments, header, tex
+  115 latexToSVG :: String -> String -> [String] -> Text -> IO Tree
+  116 latexToSVG dviExt latexExec latexArgs tex = do
+  117   latexBin <- requireExecutable latexExec
+  118   dvisvgm  <- requireExecutable "dvisvgm"
+  119   withTempDir $ \tmp_dir -> withTempFile "tex" $ \tex_file ->
+  120     withTempFile "svg" $ \svg_file -> do
+  121       let dvi_file =
+  122             tmp_dir </> replaceExtension (takeFileName tex_file) dviExt
+  123       B.writeFile tex_file (T.encodeUtf8 tex)
+  124       runCmd
+  125         latexBin
+  126         (  latexArgs
+  127         ++ [ "-interaction=nonstopmode"
+  128            , "-halt-on-error"
+  129            , "-output-directory=" ++ tmp_dir
+  130            , tex_file
+  131            ]
+  132         )
+  133       runCmd
+  134         dvisvgm
+  135         [ dvi_file
+  136         , "--precision=5"
+  137         , "--exact"    -- better bboxes.
+  138         , "--no-fonts" -- use glyphs instead of fonts.
+  139         , "--scale=0.1,-0.1"
+  140         , "--verbosity=0"
+  141         , "-o"
+  142         , svg_file
+  143         ]
+  144       svg_data <- B.readFile svg_file
+  145       case parseSvgFile svg_file svg_data of
+  146         Nothing  -> error "Malformed svg"
+  147         Just svg -> return $ postprocess $ unbox $ replaceUses svg
+  148 
+  149 mkTexScript :: String -> [String] -> [Text] -> Text -> Text
+  150 mkTexScript latexExec latexArgs texHeaders tex =
+  151   T.unlines
+  152     $  [ "% " <> T.pack (unwords (latexExec : latexArgs))
+  153        , "\\documentclass[preview]{standalone}"
+  154        , "\\usepackage{amsmath}"
+  155        , "\\usepackage{gensymb}"
+  156        ]
+  157     ++ texHeaders
+  158     ++ [ "\\usepackage[english]{babel}"
+  159        , "\\linespread{1}"
+  160        , "\\begin{document}"
+  161        , tex
+  162        , "\\end{document}"
+  163        ]
+  164 
+  165 {- Packages used by manim.
+  166 
+  167 \\\usepackage{amsmath}\n\
+  168 \\\usepackage{amssymb}\n\
+  169 \\\usepackage{dsfont}\n\
+  170 \\\usepackage{setspace}\n\
+  171 \\\usepackage{relsize}\n\
+  172 \\\usepackage{textcomp}\n\
+  173 \\\usepackage{mathrsfs}\n\
+  174 \\\usepackage{calligra}\n\
+  175 \\\usepackage{wasysym}\n\
+  176 \\\usepackage{ragged2e}\n\
+  177 \\\usepackage{physics}\n\
+  178 \\\usepackage{xcolor}\n\
+  179 \\\usepackage{textcomp}\n\
+  180 \\\usepackage{xfrac}\n\
+  181 \\\usepackage{microtype}\n\
+  182 -}
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Math.Common.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Math.Common.hs.html new file mode 100644 index 0000000..790c90b --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Math.Common.hs.html @@ -0,0 +1,243 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE FlexibleInstances #-}
+    2 {-# OPTIONS_GHC -Wno-orphans #-}
+    3 {-|
+    4 Module      : Reanimate.Math.Common
+    5 Copyright   : Written by David Himmelstrup
+    6 License     : Unlicense
+    7 Maintainer  : lemmih@gmail.com
+    8 Stability   : experimental
+    9 Portability : POSIX
+   10 
+   11 Low-level primitives related to computational geometry.
+   12 
+   13 -}
+   14 module Reanimate.Math.Common
+   15   ( -- * Ring
+   16     Ring(..)
+   17   , ringSize            -- :: Ring a -> Int
+   18   , ringAccess          -- :: Ring a -> Int -> V2 a
+   19   , ringClamp           -- :: Ring a -> Int -> Int
+   20   , ringUnpack          -- :: Ring a -> Vector (V2 a)
+   21   , ringPack            -- :: Vector (V2 a) -> Ring a
+   22   , ringMap             -- :: (V2 a -> V2 b) -> Ring a -> Ring b
+   23   , ringRayIntersect    -- :: Ring Rational -> (Int, Int) -> (Int,Int) -> Maybe (V2 Rational)
+   24     -- * Math
+   25   , area                -- :: Fractional a => V2 a -> V2 a -> V2 a -> a
+   26   , area2X              -- :: Fractional a => V2 a -> V2 a -> V2 a -> a
+   27   , isLeftTurn          -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
+   28   , isLeftTurnOrLinear  -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
+   29   , isRightTurn         -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
+   30   , isRightTurnOrLinear -- :: (Num a, Ord a) => V2 a -> V2 a -> V2 a -> Bool
+   31   , direction           -- :: Num a => V2 a -> V2 a -> V2 a -> a
+   32   , isInside            -- :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
+   33   , isInsideStrict      -- :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
+   34   , barycentricCoords   -- :: Fractional a => V2 a -> V2 a -> V2 a -> V2 a -> (a, a, a)
+   35   , rayIntersect        -- :: (Fractional a, Ord a) => (V2 a,V2 a) -> (V2 a,V2 a) -> Maybe (V2 a)
+   36   , isBetween           -- :: (Ord a, Fractional a) => V2 a -> (V2 a, V2 a) -> Bool
+   37   , lineIntersect       -- :: (Ord a, Fractional a) => (V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
+   38   , distSquared         -- :: (Fractional a) => V2 a -> V2 a -> a
+   39   , approxDist          -- :: (Real a, Fractional a) => V2 a -> V2 a -> a
+   40   , distance'           -- :: (Real a, Fractional a) => V2 a -> V2 a -> Double
+   41   , triangleAngles      -- :: V2 Double -> V2 Double -> V2 Double -> (Double, Double, Double)
+   42   , Epsilon(..)
+   43   ) where
+   44 
+   45 import           Data.Vector    (Vector)
+   46 import qualified Data.Vector    as V
+   47 import           Linear.Matrix  (det33)
+   48 import           Linear.Metric
+   49 import           Linear.V2
+   50 import           Linear.V3
+   51 import           Linear.Vector
+   52 import           Linear.Epsilon
+   53 
+   54 instance Epsilon Rational where
+   55   nearZero r = r==0
+   56 
+   57 -- | Circular collection of pairs.
+   58 newtype Ring a = Ring (Vector (V2 a))
+   59 
+   60 -- | Number of elements in the ring.
+   61 ringSize :: Ring a -> Int
+   62 ringSize (Ring v) = length v
+   63 
+   64 -- | Safe method for accessing elements in the ring.
+   65 ringAccess :: Ring a -> Int -> V2 a
+   66 ringAccess (Ring v) i = v V.! mod i (length v)
+   67 
+   68 -- | Clamp index to within the usable range for the ring.
+   69 ringClamp :: Ring a -> Int -> Int
+   70 ringClamp (Ring v) i = mod i (length v)
+   71 
+   72 -- | Convert ring to a vector.
+   73 ringUnpack :: Ring a -> Vector (V2 a)
+   74 ringUnpack (Ring v) = v
+   75 
+   76 -- | Convert vector to a ring.
+   77 ringPack :: Vector (V2 a) -> Ring a
+   78 ringPack = Ring
+   79 
+   80 -- | Map each element of a ring.
+   81 ringMap :: (V2 a -> V2 b) -> Ring a -> Ring b
+   82 ringMap fn (Ring v) = Ring (V.map fn v)
+   83 
+   84 -- | Compute the intersection of two pairs of nodes in the ring.
+   85 ringRayIntersect :: Ring Rational -> (Int, Int) -> (Int,Int) -> Maybe (V2 Rational)
+   86 ringRayIntersect p (a,b) (c,d) =
+   87   rayIntersect (ringAccess p a, ringAccess p b) (ringAccess p c, ringAccess p d)
+   88 
+   89 -- | Compute area of triangle.
+   90 area :: Fractional a => V2 a -> V2 a -> V2 a -> a
+   91 area a b c = 1/2 * area2X a b c
+   92 
+   93 -- | Compute 2x area of triangle. This avoids a division.
+   94 area2X :: Fractional a => V2 a -> V2 a -> V2 a -> a
+   95 area2X (V2 a1 a2) (V2 b1 b2) (V2 c1 c2) =
+   96   det33 (V3 (V3 a1 a2 1)
+   97             (V3 b1 b2 1)
+   98             (V3 c1 c2 1))
+   99 
+  100 compareEpsZero :: (Ord a, Fractional a, Epsilon a) => a -> Ordering
+  101 compareEpsZero val
+  102   | nearZero val  = EQ
+  103   | otherwise     = compare val 0
+  104 
+  105 {-# INLINE isLeftTurn #-}
+  106 -- | Return @True@ iff the line from @p1@ to @p2@ makes a left-turn to @p3@.
+  107 isLeftTurn :: (Fractional a, Ord a, Epsilon a) => V2 a -> V2 a -> V2 a -> Bool
+  108 isLeftTurn p1 p2 p3 =
+  109   case compareEpsZero (direction p1 p2 p3) of
+  110     LT -> True
+  111     EQ -> False -- colinear
+  112     GT -> False
+  113 
+  114 {-# INLINE isLeftTurnOrLinear #-}
+  115 -- | Return @True@ iff the line from @p1@ to @p2@ does not make a right-turn to @p3@.
+  116 isLeftTurnOrLinear :: (Fractional a, Ord a, Epsilon a) => V2 a -> V2 a -> V2 a -> Bool
+  117 isLeftTurnOrLinear p1 p2 p3 =
+  118   case compareEpsZero (direction p1 p2 p3) of
+  119     LT -> True
+  120     EQ -> True -- colinear
+  121     GT -> False
+  122 
+  123 {-# INLINE isRightTurn #-}
+  124 -- | Return @True@ iff the line from @p1@ to @p2@ makes a right-turn to @p3@.
+  125 isRightTurn :: (Fractional a, Ord a, Epsilon a) => V2 a -> V2 a -> V2 a -> Bool
+  126 isRightTurn a b c = not (isLeftTurnOrLinear a b c)
+  127 
+  128 {-# INLINE isRightTurnOrLinear #-}
+  129 -- | Return @True@ iff the line from @p1@ to @p2@ does not make a left-turn to @p3@.
+  130 isRightTurnOrLinear :: (Fractional a, Ord a, Epsilon a) => V2 a -> V2 a -> V2 a -> Bool
+  131 isRightTurnOrLinear a b c = not (isLeftTurn a b c)
+  132 
+  133 {-# INLINE direction #-}
+  134 -- | Compute the change in direction in a line between the three points.
+  135 direction :: Num a => V2 a -> V2 a -> V2 a -> a
+  136 direction p1 p2 p3 = crossZ (p3-p1) (p2-p1)
+  137 
+  138 {-# INLINE isInside #-}
+  139 -- | Returns @True@ if the fourth argument is inside the triangle or
+  140 --   on the border.
+  141 isInside :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
+  142 isInside a b c d =
+  143     s >= 0 && s <= 1 && t >= 0 && t <= 1 && i >= 0 && i <= 1
+  144   where
+  145     (s, t, i) = barycentricCoords a b c d
+  146 
+  147 {-# INLINE isInsideStrict #-}
+  148 -- | Returns @True@ iff the fourth argument is inside the triangle.
+  149 isInsideStrict :: (Fractional a, Ord a) => V2 a -> V2 a -> V2 a -> V2 a -> Bool
+  150 isInsideStrict a b c d =
+  151     s > 0 && s < 1 && t > 0 && t < 1 && i > 0 && i < 1
+  152   where
+  153     (s, t, i) = barycentricCoords a b c d
+  154 
+  155 {-# INLINE barycentricCoords #-}
+  156 -- | Compute relative coordinates inside the triangle. Invariant: @a+b+c=1@
+  157 barycentricCoords :: Fractional a => V2 a -> V2 a -> V2 a -> V2 a -> (a, a, a)
+  158 barycentricCoords (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x y) =
+  159     (lam1, lam2, lam3)
+  160   where
+  161     lam1 = ((y2-y3)*(x-x3) + (x3 - x2)*(y-y3)) /
+  162            ((y2-y3)*(x1-x3) + (x3-x2)*(y1-y3))
+  163     lam2 = ((y3-y1)*(x-x3) + (x1-x3)*(y-y3)) /
+  164            ((y2-y3)*(x1-x3) + (x3-x2)*(y1-y3))
+  165     lam3 = 1 - lam1 - lam2
+  166 
+  167 
+  168 {-# INLINE rayIntersect #-}
+  169 -- | Compute intersection of two infinite lines.
+  170 rayIntersect :: (Fractional a, Ord a) => (V2 a,V2 a) -> (V2 a,V2 a) -> Maybe (V2 a)
+  171 rayIntersect (V2 x1 y1,V2 x2 y2) (V2 x3 y3, V2 x4 y4)
+  172   | yBot == 0 = Nothing
+  173   | otherwise = Just $
+  174     V2 (xTop/xBot) (yTop/yBot)
+  175   where
+  176     xTop = (x1*y2 - y1*x2)*(x3-x4) - (x1 - x2)*(x3*y4-y3*x4)
+  177     xBot = (x1-x2)*(y3-y4)-(y1-y2)*(x3-x4)
+  178     yTop = (x1*y2 - y1*x2)*(y3-y4) - (y1-y2)*(x3*y4-y3*x4)
+  179     yBot = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
+  180 
+  181 {-# INLINE isBetween #-}
+  182 -- | Returns @True@ iff a point is on a line segment.
+  183 isBetween :: (Ord a, Fractional a) => V2 a -> (V2 a, V2 a) -> Bool
+  184 isBetween (V2 x y) (V2 x1 y1, V2 x2 y2) =
+  185   ((y1 > y) /= (y2 > y) || y == y1 || y == y2) && -- y is between y1 and y2
+  186   ((x1 > x) /= (x2 > x) || x == x1 || x == x2)
+  187 
+  188 {-# INLINE lineIntersect #-}
+  189 -- | Compute intersection of two line segments.
+  190 lineIntersect :: (Ord a, Fractional a) => (V2 a, V2 a) -> (V2 a, V2 a) -> Maybe (V2 a)
+  191 lineIntersect a b =
+  192   case rayIntersect a b of
+  193     Just u
+  194       | isBetween u a && isBetween u b -> Just u
+  195     _ -> Nothing
+  196 
+  197 -- circleIntersect :: (Ord a, Fractional a) => (V2 a, V2 a) -> (V2 a, V2 a) -> [V2 a]
+  198 
+  199 -- | Compute the square of the distance between two points.
+  200 distSquared :: (Num a) => V2 a -> V2 a -> a
+  201 distSquared a b = quadrance (a ^-^ b)
+  202 
+  203 -- | Approximate the distance between two points.
+  204 approxDist :: (Real a, Fractional a) => V2 a -> V2 a -> a
+  205 approxDist a b = realToFrac (sqrt (realToFrac (distSquared a b) :: Double))
+  206 
+  207 -- | Approximate the distance between two points.
+  208 distance' :: (Real a, Fractional a) => V2 a -> V2 a -> Double
+  209 distance' a b = sqrt (realToFrac (distSquared a b))
+  210 
+  211 -- sum of angles is always pi.
+  212 -- | Approximate the angles of a triangle.
+  213 triangleAngles :: V2 Double -> V2 Double -> V2 Double -> (Double, Double, Double)
+  214 triangleAngles a b c =
+  215     (findAngle (b-a) (c-a)
+  216     ,findAngle (c-b) (a-b)
+  217     ,findAngle (a-c) (b-c))
+  218   where
+  219     findAngle v1 v2 = abs (atan2 (crossZ v1 v2) (dot v1 v2))
+  220     -- findAngle v1 v2 = acos (dot v1 v2 / (norm v1 * norm v2))
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Math.Polygon.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Math.Polygon.hs.html new file mode 100644 index 0000000..f3b5449 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Math.Polygon.hs.html @@ -0,0 +1,824 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE BangPatterns    #-}
+    2 {-# LANGUAGE ConstraintKinds #-}
+    3 {-# OPTIONS_HADDOCK hide #-}
+    4 module Reanimate.Math.Polygon
+    5   ( APolygon(..)
+    6   , Polygon
+    7   , FPolygon
+    8   , P
+    9   , mkPolygon     -- :: (Fractional a, Ord a) => V.Vector (V2 a) -> APolygon a
+   10   , mkPolygonFromRing -- :: (Fractional a, Ord a) => Ring a -> APolygon a
+   11   , castPolygon   -- :: (Real a, Fractional b, Ord a) => APolygon a -> APolygon b
+   12   , pParent       -- :: Polygon -> Int -> Int -> Int
+   13   , pSetOffset    -- :: APolygon a -> Int -> APolygon a
+   14   , pAdjustOffset -- :: APolygon a -> Int -> APolygon a
+   15   , pSize         -- :: APolygon a -> Int
+   16   , pNull         -- :: APolygon a -> Bool
+   17   , pNext         -- :: APolygon a -> Int -> Int
+   18   , pPrev         -- :: APolygon a -> Int -> Int
+   19   , pIsSimple     -- :: Polygon -> Bool
+   20   , pIsConvex     -- :: Polygon -> Bool
+   21   , pIsCCW        -- :: Polygon -> Bool
+   22   , pScale        -- :: Rational -> Polygon -> Polygon
+   23   , pAtCentroid   -- :: Polygon -> Polygon
+   24   , pAtCenter     -- :: Polygon -> Polygon
+   25   , pTranslate    -- :: V2 Rational -> Polygon -> Polygon
+   26   , pCenter       -- :: Polygon -> V2 Rational
+   27   , pBoundingBox  -- :: Polygon -> (Rational, Rational, Rational, Rational)
+   28   , pIsInside     -- :: Polygon -> V2 Rational -> Bool
+   29   , pAccess       -- :: APolygon a -> Int -> V2 a
+   30   , pMkWinding    -- :: Int -> Polygon
+   31   , pDeoverlap    -- :: Polygon -> Polygon
+   32   , pCycles       -- :: Polygon -> [Polygon]
+   33   , pCycle        -- :: (Real a, Fractional a, Ord a) => APolygon a -> Double -> APolygon a
+   34   , pCentroid     -- :: Polygon -> V2 Rational
+   35   , pMapEdges     -- :: (V2 Rational -> V2 Rational -> a) -> Polygon -> V.Vector a
+   36   , pArea         -- :: Polygon -> Rational
+   37   , pCircumference   -- :: (Real a, Fractional a) => APolygon a -> a
+   38   , pCircumference'  -- :: (Real a, Fractional a) => APolygon a -> Double
+   39   , pAddPoints       -- :: Int -> Polygon -> Polygon
+   40   , pAddPointsRestricted -- :: [Int] -> Int -> Polygon -> Polygon
+   41   , pAddPointsBetween -- :: (Fractional a, Ord a, Real a) => (Int, Int) -> Int -> APolygon a -> APolygon a
+   42   , pRayIntersect    -- :: Polygon -> (Int, Int) -> (Int,Int) -> Maybe (V2 Rational)
+   43   , pOverlap         -- :: Polygon -> Polygon -> Polygon
+   44   , pCuts         -- :: Polygon -> [(Polygon,Polygon)]
+   45   , pCutEqual     -- :: Polygon -> (Polygon, Polygon)
+   46   -- * Triangulation
+   47   , isValidTriangulation     -- :: Polygon -> Triangulation -> Bool
+   48   , triangulationsToPolygons -- :: Polygon -> Triangulation -> [Polygon]
+   49   -- * Single-Source-Shortest-Path
+   50   , ssspVisibility -- :: Polygon -> Polygon
+   51   , ssspWindows -- :: Polygon -> [(V2 Rational, V2 Rational)]
+   52   -- * Duals
+   53   , pdualPolygons -- :: Polygon -> PDual -> [Polygon]
+   54   -- * Built-in shapes for testing
+   55   , triangle  -- :: Polygon
+   56   , triangle' -- :: [P]
+   57   , shape1  -- :: Polygon
+   58   , shape2  -- :: Polygon
+   59   , shape3  -- :: Polygon
+   60   , shape4  -- :: Polygon
+   61   , shape5  -- :: Polygon
+   62   , shape6  -- :: Polygon
+   63   , shape7  -- :: Polygon
+   64   , shape8  -- :: Polygon
+   65   , shape9  -- :: Polygon
+   66   , shape10 -- :: Polygon
+   67   , shape11 -- :: Polygon
+   68   , shape12 -- :: Polygon
+   69   , shape13 -- :: Polygon
+   70   , shape14 -- :: Polygon
+   71   , shape15 -- :: Polygon
+   72   , shape16 -- :: Polygon
+   73   , shape17 -- :: Polygon
+   74   , shape18 -- :: Polygon
+   75   , shape19 -- :: Polygon
+   76   , shape20 -- :: Polygon
+   77   , shape21 -- :: Polygon
+   78   , shape22 -- :: Polygon
+   79   , shape23 -- :: Polygon
+   80   , concave -- :: Polygon
+   81   -- * Internals
+   82   , pRing       -- :: APolygon a -> Ring a
+   83   , pUnsafeMap  -- :: (Ring a -> Ring a) -> APolygon a -> APolygon a
+   84   , pCopy       -- :: Polygon -> Polygon
+   85   , pGenerate   -- :: [(Double, Double)] -> Polygon
+   86   , pUnGenerate -- :: Polygon -> [(Double, Double)]
+   87   , Epsilon
+   88   ) where
+   89 
+   90 -- import           Control.Exception
+   91 import           Data.Hashable
+   92 import           Data.List                  (intersect, maximumBy, sort, sortOn,
+   93                                              tails)
+   94 import           Data.Maybe
+   95 import           Data.Ratio
+   96 import           Data.Serialize
+   97 import           Data.Vector                (Vector)
+   98 import qualified Data.Vector                as V
+   99 import           Linear.V2
+  100 import           Linear.Vector
+  101 import           Reanimate.Math.Common
+  102 -- import           Reanimate.Math.EarClip
+  103 import           Reanimate.Math.SSSP
+  104 import           Reanimate.Math.Triangulate
+  105 
+  106 -- import Debug.Trace
+  107 
+  108 -- Generate random polygons, options:
+  109 --   1. put corners around a circle. Vary the radius.
+  110 --   2. close a hilbert curve
+  111 type FPolygon = APolygon Double
+  112 -- Optimize representation?
+  113 --   Polygon = (Vector XNumerator, Vector XDenominator
+  114 --             ,Vector YNumerator, Vector YDenominator)
+  115 data APolygon a = Polygon
+  116   { polygonPoints        :: Vector (V2 a)
+  117   , polygonOffset        :: Int
+  118   , polygonTriangulation :: Triangulation
+  119   , polygonSSSP          :: Vector SSSP
+  120   }
+  121 type Polygon = APolygon Rational
+  122 type P = V2 Double
+  123 
+  124 instance Show a => Show (APolygon a) where
+  125   show = show . V.toList . polygonPoints
+  126 
+  127 instance Hashable a => Hashable (APolygon a) where
+  128   hashWithSalt s p = V.foldl' hashWithSalt s (polygonPoints p)
+  129 
+  130 instance (PolyCtx a, Serialize a) => Serialize (APolygon a) where
+  131   put = put . V.toList . polygonPoints
+  132   get = mkPolygon . V.fromList <$> get
+  133 
+  134 pRing :: APolygon a -> Ring a
+  135 pRing = ringPack . polygonPoints
+  136 
+  137 type PolyCtx a = (Real a, Fractional a, Epsilon a)
+  138 
+  139 mkPolygon :: PolyCtx a => V.Vector (V2 a) -> APolygon a
+  140 mkPolygon points = Polygon
+  141     { polygonPoints = points
+  142     , polygonOffset = 0
+  143     , polygonTriangulation = trig
+  144     , polygonSSSP = V.generate n $ \i -> sssp ring (dual i trig)
+  145     }
+  146   where
+  147     n = length points
+  148     ring = ringPack points
+  149     trig = triangulate ring
+  150       -- earClip ring
+  151 
+  152 castPolygon :: (PolyCtx a, PolyCtx b) => APolygon a -> APolygon b
+  153 castPolygon = mkPolygon . V.map (fmap realToFrac) . polygonPoints
+  154 
+  155 mkPolygonFromRing :: PolyCtx a => Ring a -> APolygon a
+  156 mkPolygonFromRing = mkPolygon . ringUnpack
+  157 
+  158 pUnsafeMap :: (Ring a -> Ring a) -> APolygon a -> APolygon a
+  159 pUnsafeMap fn p = p{ polygonPoints = ringUnpack (fn (pRing p)) }
+  160 
+  161 -- pParent p i j = shortest-path parent from j to i
+  162 pParent :: APolygon a -> Int -> Int -> Int
+  163 pParent p i j =
+  164     (sTree V.! mod (j + polygonOffset p) n - polygonOffset p) `mod` n
+  165   where
+  166     sTree = polygonSSSP p V.! mod (i + polygonOffset p) n
+  167     n = pSize p
+  168 
+  169 pCopy :: Polygon -> Polygon
+  170 pCopy p = mkPolygon $ V.generate (pSize p) $ pAccess p
+  171 
+  172 pSetOffset :: APolygon a -> Int -> APolygon a
+  173 pSetOffset p offset =
+  174   p { polygonOffset = offset `mod` pSize p }
+  175 
+  176 pAdjustOffset :: APolygon a -> Int -> APolygon a
+  177 pAdjustOffset p offset =
+  178   p { polygonOffset = (polygonOffset p + offset) `mod` pSize p }
+  179 
+  180 {-# INLINE pSize #-}
+  181 pSize :: APolygon a -> Int
+  182 pSize = length . polygonPoints
+  183 
+  184 pNull :: APolygon a -> Bool
+  185 pNull = V.null . polygonPoints
+  186 
+  187 pNext :: APolygon a -> Int -> Int
+  188 pNext p i = (i+1) `mod` pSize p
+  189 
+  190 pPrev :: APolygon a -> Int -> Int
+  191 pPrev p i = (i-1) `mod` pSize p
+  192 
+  193 -- When is a polygon valid/simple?
+  194 --   It is counter-clockwise.
+  195 --   No edges intersect.
+  196 -- O(n^2)
+  197 -- 'checkEdge' takes 90% of the time.
+  198 pIsSimple :: Polygon -> Bool
+  199 pIsSimple p | pSize p < 3 = False
+  200 pIsSimple p = pIsCCW p && noDups && checkEdge 0 2
+  201   where
+  202     noDups = checkForDups (sort (V.toList (polygonPoints p)))
+  203     checkForDups (x:y:xs)
+  204       = x /= y && checkForDups (y:xs)
+  205     checkForDups _ = True
+  206     len = pSize p
+  207     -- check i,i+1 against j,j+1
+  208     -- j > i+1
+  209     checkEdge i j
+  210       | j >= len = (i > len-3) || checkEdge (i+1) (i+3)
+  211       | otherwise =
+  212         case lineIntersect (pAccess p i, pAccess p $ i+1)
+  213                            (pAccess p j, pAccess p $ j+1) of
+  214           Just u | u /= pAccess p i -> False
+  215           _nothing                  -> checkEdge i (j+1)
+  216 
+  217 pScale :: Rational -> Polygon -> Polygon
+  218 pScale s = pUnsafeMap (ringMap (^* s))
+  219 
+  220 pAtCentroid :: Polygon -> Polygon
+  221 pAtCentroid p = pTranslate (negate c) p
+  222   where c = pCentroid p ^/ 2
+  223 
+  224 pAtCenter :: Polygon -> Polygon
+  225 pAtCenter p = pTranslate (negate $ pCenter p) p
+  226 
+  227 pTranslate :: V2 Rational -> Polygon -> Polygon
+  228 pTranslate v = pUnsafeMap (ringMap (+v))
+  229 
+  230 pCenter :: Polygon -> V2 Rational
+  231 pCenter p = V2 (x+w/2) (y+h/2)
+  232   where
+  233     (x,y,w,h) = pBoundingBox p
+  234 
+  235 -- Returns (min-x, min-y, width, height)
+  236 pBoundingBox :: Polygon -> (Rational, Rational, Rational, Rational)
+  237 pBoundingBox = \p ->
+  238     let V2 x y = pAccess p 0 in
+  239     case V.foldl' worker (x, y, 0, 0) (polygonPoints p) of
+  240       (xMin, yMin, xMax, yMax) ->
+  241         (xMin, yMin, xMax-xMin, yMax-yMin)
+  242   where
+  243     worker (xMin,yMin,xMax,yMax) (V2 thisX thisY) =
+  244       (min xMin thisX, min yMin thisY
+  245       ,max xMax thisX, max yMax thisY)
+  246 
+  247 -- Place n points on a circle, use one parameter to slide the points back and forth.
+  248 -- Use second parameter to move points closer to center circle.
+  249 pGenerate :: [(Double, Double)] -> Polygon
+  250 pGenerate points
+  251   | len < 4 = error "pGenerate: require at least four points"
+  252   | otherwise = mkPolygon $ V.fromList
+  253   [ V2 (realToFrac $ cos ang * rMod)
+  254        (realToFrac $ sin ang * rMod)
+  255   | (i,(angMod,rMod))  <- zip [0..] points
+  256   , let minAngle = tau / len * i - pi
+  257         maxAngle = tau / len * (i+1) - pi
+  258         ang = minAngle + (maxAngle-minAngle)*angMod
+  259   ]
+  260   where
+  261     tau = 2*pi
+  262     len = fromIntegral (length points)
+  263 
+  264 pUnGenerate :: Polygon -> [(Double, Double)]
+  265 pUnGenerate p =
+  266     [ worker i (fmap realToFrac e)
+  267     | (i,e) <- zip [0..] (V.toList $ polygonPoints p) ]
+  268   where
+  269     len = fromIntegral (pSize p)
+  270     worker i (V2 x y) =
+  271       let ang = atan2 y x
+  272           minAngle = tau / len * i - pi
+  273           maxAngle = tau / len * (i+1) - pi
+  274       in ((ang-minAngle)/(maxAngle-minAngle), sqrt (x*x+y*y))
+  275     tau = 2*pi
+  276 
+  277 -- When is a triangulation valid?
+  278 --   Intersection: No internal edges intersect.
+  279 --   Completeness: All edge neighbours share a single internal edge.
+  280 isValidTriangulation :: Polygon -> Triangulation -> Bool
+  281 isValidTriangulation p t = isComplete && intersectionFree
+  282   where
+  283     o = polygonOffset p
+  284     isComplete = all isProper [0 .. pSize p-1]
+  285     isProper i =
+  286       let j = pNext p i in
+  287       length ((pPrev p i : (t V.! i)) `intersect` (pNext p j : t V.! j)) == 1
+  288     intersectionFree = and
+  289       [ case lineIntersect (pAccess p (a-o), pAccess p (b-o)) (pAccess p (c-o), pAccess p (d-o)) of
+  290           Nothing -> True
+  291           Just u  -> u == pAccess p (a-o) || u == pAccess p (b-o) ||
+  292                      u == pAccess p (c-o) || u == pAccess p (d-o)
+  293       | ((a,b),(c,d)) <- edgePairs ]
+  294     edgePairs = [ (e1, e2) | (e1, rest) <- zip edges (drop 1 $ tails edges), e2 <- rest]
+  295     edges =
+  296       [ (n, i)
+  297       | (n, lst) <- zip [0..] (V.toList t)
+  298       , i <- lst
+  299       , n < i
+  300       ]
+  301 
+  302 triangulationsToPolygons :: Polygon -> Triangulation -> [Polygon]
+  303 triangulationsToPolygons p t =
+  304   [ mkPolygon $ V.fromList
+  305     [ pAccess p g, pAccess p i, pAccess p j ]
+  306   | i <- [0 .. pSize p-1]
+  307   , let js = filter (i<) $ t V.! i
+  308   , (g, j) <- zip (i-1:js) js
+  309   ]
+  310 
+  311 pIsInside :: Polygon -> V2 Rational -> Bool
+  312 pIsInside p point = or
+  313   [ isInside (rawAccess g) (rawAccess i) (rawAccess j) point
+  314   | i <- [0 .. pSize p-1]
+  315   , let js = filter (i<) $ polygonTriangulation p V.! i
+  316   , (g, j) <- zip (i-1:js) js
+  317   ]
+  318   where
+  319     rawAccess x = polygonPoints p V.! x
+  320 
+  321 -- reducePolygons :: Int -> [Polygon] -> [Polygon]
+  322 -- reducePolygons n ps
+  323 --   | length ps <= n = ps
+  324 --   | otherwise =
+  325 --     let p = findSmallest ps
+  326 --         es = edges p
+  327 --         e = findSmallest es
+  328 --     in reducePolygons n (merge p e : delete p (delete e ps))
+  329 --   where
+  330 --     findSmallest = minimumBy (comparing area2X)
+  331 --     shareEdge p1 p2 =
+  332 
+  333 {-# INLINE pAccess #-}
+  334 pAccess :: APolygon a -> Int -> V2 a
+  335 pAccess p i = -- polygonPoints p V.! ((polygonOffset p + i) `mod` pSize p)
+  336   polygonPoints p `V.unsafeIndex` ((polygonOffset p + i) `mod` pSize p)
+  337 
+  338 triangle :: Polygon
+  339 triangle = mkPolygon $ V.fromList [V2 1 1, V2 0 0, V2 2 0]
+  340 
+  341 triangle' :: [P]
+  342 triangle' = reverse [V2 1 1, V2 0 0, V2 2 0]
+  343 
+  344 shape1 :: Polygon
+  345 shape1 = mkPolygon $ V.fromList
+  346   [ V2 0 0, V2 2 0
+  347   , V2 2 1, V2 2 2, V2 2 3, V2 2 4, V2 2 5, V2 2 6
+  348   , V2 1 1, V2 0 1 ]
+  349 
+  350 shape2 :: Polygon
+  351 shape2 = mkPolygon $ V.fromList
+  352   [ V2 0 0, V2 1 0, V2 1 1, V2 2 1, V2 2 (-1), V2 0 (-1), V2 0 (-2)
+  353   , V2 3 (-2), V2 3 2, V2 0 2]
+  354 
+  355 shape3 :: Polygon
+  356 shape3 = mkPolygon $ V.fromList
+  357   [ V2 0 0, V2 1 0, V2 1 1, V2 2 1, V2 2 2, V2 0 2]
+  358 
+  359 shape4 :: Polygon
+  360 shape4 = mkPolygon $ V.fromList
+  361   [ V2 0 0, V2 1 0, V2 1 1, V2 2 1, V2 2 (-1), V2 3 (-1),V2 3 2, V2 0 2]
+  362 
+  363 shape5 :: Polygon
+  364 shape5 = pCycles shape4 !! 2
+  365 
+  366 -- square
+  367 shape6 :: Polygon
+  368 shape6 = mkPolygon $ V.fromList [ V2 0 0, V2 1 0, V2 1 1, V2 0 1 ]
+  369 
+  370 shape7 :: Polygon
+  371 shape7 = pScale 6 $ mkPolygon $ V.fromList
+  372         [V2 ((-1567171105775771) % 144115188075855872) ((-7758063241391039) % 1152921504606846976)
+  373         ,V2 ((-2711114907999263) % 18014398509481984) ((-3561889280168807) % 18014398509481984)
+  374         ,V2 ((-6897139157863177) % 72057594037927936) ((-1632144794297397) % 4503599627370496)
+  375         ,V2 (5592137945106423 % 36028797018963968) ((-71351641856107) % 281474976710656)
+  376         ,V2 (2568147525079071 % 4503599627370496) ((-4312925637247687) % 18014398509481984)
+  377         ,V2 (1291079014395023 % 2251799813685248) (321513444515769 % 2251799813685248)
+  378         ,V2 (2071709221627247 % 4503599627370496) (4019115966736491 % 9007199254740992)
+  379         ,V2 ((-1589087869859839) % 144115188075855872) (4904023654354179 % 9007199254740992)
+  380         ,V2 ((-2328090886101149) % 36028797018963968) (2587887893460759 % 36028797018963968)
+  381         ,V2 ((-7990199074159871) % 18014398509481984) (1301850651537745 % 4503599627370496)]
+  382 
+  383 shape8 :: Polygon
+  384 shape8 = pScale 10 $ pGenerate
+  385           [(0.36,0.4),(0.7,1.8e-2),(0.7,0.2),(0.1,0.4),(0.2,0.2),(0.7,0.1),(0.4,8.0e-2)]
+  386 
+  387 shape9 :: Polygon
+  388 shape9 = pScale 5 $ pGenerate
+  389   [(0.5,0.2),(0.7,0.6),(0.4,0.3),(0.1,0.7),(0.3,1.0e-2),(0.5,0.3),(0.2,0.8),(0.1,0.8),(0.7,6.0e-2),(0.1,0.6)]
+  390 
+  391 shape10 :: Polygon
+  392 shape10 = pGenerate
+  393   [(0.4,0.7),(0.2,0.2),(0.3,0.9),(5.0e-2,0.1),(0.7,1.0e-2),(0.7,0.9),(0.2,0.1),(0.5,6.0e-2),(0.6,9.0e-2)]
+  394 
+  395 shape11 :: Polygon
+  396 shape11 = pGenerate
+  397   [(0.1,0.8),(0.7,0.6),(0.7,0.4),(0.3,0.5),(0.8,0.9),(0.8,6.0e-2),(1.0e-2,4.0e-2),(0.8,0.1)]
+  398 
+  399 shape12 :: Polygon
+  400 shape12 = mkPolygon $ V.fromList
+  401   [ V2 0 0, V2 0.5 1.5, V2 2 2, V2 (-2) 2, V2 (-0.5) 1.5 ]
+  402 
+  403 -- F shape
+  404 shape13 :: Polygon
+  405 shape13 = pCycles (mkPolygon $ V.reverse (V.fromList
+  406   [ V2 0 0, V2 0 2
+  407   , V2 1 2, V2 1 1.7, V2 0.3 1.7, V2 0.3 1
+  408   , V2 1 1, V2 1 0.7
+  409   , V2 0.3 0.7, V2 0.3 0 ])) !! 7
+  410 
+  411 -- E shape
+  412 shape14 :: Polygon
+  413 shape14 = pCycles (mkPolygon $ V.reverse $ V.fromList
+  414   [ V2 0 0, V2 0 2 -- up
+  415   , V2 1 2, V2 1 1.7, V2 0.3 1.7, V2 0.3 1 -- first prong
+  416   , V2 1 1, V2 1 0.7, V2 0.3 0.7, V2 0.3 0.3 -- second prong
+  417   , V2 1 0.3, V2 1 0 -- last prong
+  418   ]) !! 9
+  419 
+  420 --
+  421 shape15 :: Polygon
+  422 shape15 = mkPolygon $ V.fromList
+  423   [ V2 0 0, V2 2 0
+  424   , V2 2 2, V2 1 2
+  425   , V2 1 1, V2 0 1]
+  426 
+  427 shape16 :: Polygon
+  428 shape16 = mkPolygon $ V.fromList
+  429   [ V2 0 0, V2 2 0
+  430   , V2 2 1, V2 1 1
+  431   , V2 1 2, V2 0 2]
+  432 
+  433 shape17 :: Polygon
+  434 shape17 = mkPolygon $ V.fromList
+  435   [ V2 2 0, V2 2 1
+  436   , V2 1 1, V2 1 2
+  437   , V2 0 2, V2 0 1, V2 0 0 ]
+  438 
+  439 shape18 :: Polygon
+  440 shape18 = mkPolygon $ V.fromList
+  441   [ V2 2 0, V2 2 1, V2 2 2
+  442   , V2 1 2, V2 1 1
+  443   , V2 0 1, V2 0 0 ]
+  444 
+  445 shape19 :: Polygon
+  446 shape19 = mkPolygon $ V.fromList
+  447   [ V2 (-3) (-3), V2 0 (-1)
+  448   , V2 3 (-3), V2 1 0
+  449   , V2 3 3, V2 0 1
+  450   , V2 (-3) 3, V2 (-1) 0 ]
+  451 
+  452 shape20 :: Polygon
+  453 shape20 = mkPolygon $ V.fromList
+  454   [ V2 (-3) (-3)
+  455   , V2 0 (-1)
+  456   , V2 3 (-3)
+  457   , V2 5 0
+  458   , V2 2.5 (-2)
+  459   , V2 1 0
+  460   , V2 3 3
+  461   , V2 0 1
+  462   , V2 (-3) 3
+  463   , V2 (-1) 0 ]
+  464 
+  465 shape21 :: Polygon
+  466 shape21 = mkPolygon $ V.fromList
+  467   [V2 0.0 0.0,V2 1.0 0.0,V2 1.0 1.0,V2 2.0 1.0,V2 2.0 (-1.0),V2 3.0 (-1.0)
+  468   ,V2 3.0 2.0,V2 0.0 2.0]
+  469 
+  470 shape22 :: Polygon
+  471 shape22 = pScale 2 $ mkPolygon $ V.fromList
+  472   [V2 (-0.17) (-0.08)
+  473   ,V2 (-0.34) (-0.21)
+  474   ,V2 0.0 0.0
+  475   ,V2 (-0.10) 0.60
+  476   ,V2 (-0.14) 0.19
+  477   ,V2 (-0.05) 0.03
+  478   ]
+  479 
+  480 shape23 :: Polygon
+  481 shape23 = mkPolygon $ V.fromList
+  482   [ V2 0 0, V2 4 0
+  483   , V2 4 3, V2 2 3
+  484   , V2 2 2, V2 3 2
+  485   , V2 3 1, V2 1 1
+  486   , V2 1 2, V2 2 2
+  487   , V2 2 3, V2 0 3 ]
+  488 
+  489 concave :: Polygon
+  490 concave = mkPolygon $
+  491   V.fromList [V2 0 0, V2 2 0, V2 2 2, V2 1 1, V2 0 2]
+  492 
+  493 pMkWinding :: Int -> Polygon
+  494 pMkWinding n | n < 1 = error "Polygon must have at least one winding."
+  495 pMkWinding n = mkPolygon $
+  496     V.fromList $ p0 : p1 : walkTo p1 1 n (V2 1 0) ++ reverse (walkTo p0 1 (n+2) (V2 (-1) 0))
+  497   where
+  498     p0 = V2 0 0
+  499     p1 = V2 0 1
+  500     walkTo at a b dir
+  501       | a == b = []
+  502       | otherwise =
+  503         let newAt = at + (dir ^* toRational a)
+  504         in newAt : walkTo newAt (a+1) b (rot dir)
+  505     rot (V2 x y) =
+  506       V2 y (-x)
+  507 
+  508 pDeoverlap :: Polygon -> Polygon
+  509 pDeoverlap p = mkPolygon arr
+  510   where
+  511     arr = V.generate (pSize p) worker
+  512     worker 0 = pAccess p 0
+  513     worker n =
+  514       if length (V.elemIndices (pAccess p n) (polygonPoints p)) /= 1
+  515         then
+  516           let prev = arr V.! (n-1)
+  517               this = pAccess p n
+  518           in lerp 0.99999 this prev
+  519         else pAccess p n
+  520 
+  521 pCycles :: APolygon a -> [APolygon a]
+  522 pCycles p = map (pAdjustOffset p) [0 .. pSize p-1]
+  523 
+  524 pCycle :: PolyCtx a => APolygon a -> Double -> APolygon a
+  525 pCycle p 0 = p
+  526 pCycle p t = mkPolygon $ worker 0 0
+  527   where
+  528     worker acc i
+  529       | segment + acc > limit =
+  530         V.singleton (lerp (realToFrac $ (segment + acc - limit)/segment) x y) <>
+  531         -- V.drop (i+1) (polygonPoints p) <>
+  532         V.fromList (map (pAccess p) [i+1..pSize p-1]) <>
+  533         V.fromList (map (pAccess p) [0 .. i])
+  534         -- V.take (i+1) (polygonPoints p)
+  535       | i == pSize p-1  = V.fromList (map (pAccess p) [0 .. pSize p-1])
+  536       | otherwise = worker (acc+segment) (i+1)
+  537         where
+  538           x = pAccess p i
+  539           y = pAccess p $ i+1
+  540           segment = distance' x y
+  541     len = pCircumference' p
+  542     limit = t * len
+  543 
+  544 pCentroid :: Fractional a => APolygon a -> V2 a
+  545 pCentroid p = V2 cx cy
+  546   where
+  547     a = pArea p
+  548     cx = recip (6*a) * V.sum (pMapEdges fnX p)
+  549     cy = recip (6*a) * V.sum (pMapEdges fnY p)
+  550     fnX (V2 x y) (V2 x' y') = (x+x')*(x*y' - x'*y)
+  551     fnY (V2 x y) (V2 x' y') = (y+y')*(x*y' - x'*y)
+  552 
+  553 {-# INLINE pMapEdges #-}
+  554 pMapEdges :: (V2 a -> V2 a -> b) -> APolygon a -> V.Vector b
+  555 pMapEdges fn p = V.generate n $ \i ->
+  556   if i == n-1
+  557     then fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` 0)
+  558     else fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` (i+1))
+  559   where
+  560     n = pSize p
+  561     arr = polygonPoints p
+  562 
+  563 {-# SPECIALIZE pArea :: APolygon Double -> Double #-}
+  564 {-# SPECIALIZE pArea :: APolygon Rational -> Rational #-}
+  565 pArea :: (Fractional a) => APolygon a -> a
+  566 pArea p =
+  567   -- 0.5 * V.sum (pMapEdges (\(V2 x y) (V2 x' y') -> x*y' - x'*y) p)
+  568   0.5 * worker 0 0
+  569   where
+  570     fn (V2 x y) (V2 x' y') = x*y' - x'*y
+  571     arr = polygonPoints p
+  572     worker !acc i
+  573       | i == pSize p - 1 = acc + fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` 0)
+  574       | otherwise =
+  575         worker (acc + fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` (i+1))) (i+1)
+  576 
+  577 pCircumference :: (Real a, Fractional a) => APolygon a -> a
+  578 pCircumference p = sum
+  579   [ approxDist (pAccess p i) (pAccess p $ i+1)
+  580   | i <- [0 .. pSize p-1]]
+  581 
+  582 pCircumference' :: (Real a, Fractional a) => APolygon a -> Double
+  583 pCircumference' p = sum
+  584   [ distance' (pAccess p i) (pAccess p $ i+1)
+  585   | i <- [0 .. pSize p-1]]
+  586 
+  587 
+  588 -- Add points by splitting the longest lines in half repeatedly.
+  589 pAddPoints :: PolyCtx a => Int -> APolygon a -> APolygon a
+  590 pAddPoints n p | n <= 0 = p
+  591 pAddPoints n p = pAddPoints (n-1) $
+  592     mkPolygon $ V.fromList $ concatMap worker [0 .. pSize p-1]
+  593   where
+  594     worker idx
+  595       | idx == longestEdge =
+  596         let start = pAccess p idx
+  597             end = pAccess p $ idx+1
+  598             middle = lerp 0.5 end start
+  599         in [start, middle]
+  600       | otherwise = [pAccess p idx]
+  601     longestEdge = maximumBy cmpLength [0 .. pSize p-1]
+  602     cmpLength a b =
+  603       distSquared (pAccess p a) (pAccess p $ a+1) `compare`
+  604       distSquared (pAccess p b) (pAccess p $ b+1)
+  605 
+  606 pAddPointsRestricted :: PolyCtx a => [(V2 a, V2 a)] -> Int -> APolygon a -> APolygon a
+  607 pAddPointsRestricted _immutableEdges n p | n <= 0 = p
+  608 pAddPointsRestricted immutableEdges n p = pAddPointsRestricted immutableEdges (n-1) $
+  609     mkPolygon $ V.fromList $ concatMap worker [0 .. pSize p-1]
+  610   where
+  611     isImmutable idx =
+  612       (pAccess p idx, pAccess p $ idx+1) `elem` immutableEdges ||
+  613       (pAccess p $ idx+1, pAccess p idx) `elem` immutableEdges
+  614     worker idx
+  615       | idx == longestEdge && not (isImmutable idx) =
+  616         let start = pAccess p idx
+  617             end = pAccess p $ idx+1
+  618             middle = lerp 0.5 end start
+  619         in [start, middle]
+  620       | otherwise = [pAccess p idx]
+  621     longestEdge = maximumBy cmpLength [0 .. pSize p-1]
+  622     cmpLength a _ | isImmutable a = LT
+  623     cmpLength _ b | isImmutable b = GT
+  624     cmpLength a b =
+  625       distSquared (pAccess p a) (pAccess p $ a+1) `compare`
+  626       distSquared (pAccess p b) (pAccess p $ b+1)
+  627 
+  628 pAddPointsBetween :: PolyCtx a => (Int, Int) -> Int -> APolygon a -> APolygon a
+  629 pAddPointsBetween _ n p | n <= 0 = p
+  630 pAddPointsBetween (i,l) n p = pAddPointsBetween (i,l+1) (n-1) $
+  631     mkPolygon $ V.fromList $ concatMap worker [0 .. pSize p-1]
+  632   where
+  633     worker idx
+  634       | idx == longestEdge =
+  635         let start = pAccess p idx
+  636             end = pAccess p $ idx+1
+  637             middle = lerp 0.5 end start
+  638         in [start, middle]
+  639       | otherwise = [pAccess p idx]
+  640     longestEdge = maximumBy cmpLength [i .. i+l-1]
+  641     cmpLength a b =
+  642       distSquared (pAccess p a) (pAccess p $ a+1) `compare`
+  643       distSquared (pAccess p b) (pAccess p $ b+1)
+  644 
+  645 -- addPoints :: Int -> Polygon -> Polygon
+  646 -- addPoints n p = mkPolygon $ V.fromList $ worker n 0 (map (pAccess p) [0..s])
+  647 --   where
+  648 --     worker 0 _ rest = init rest
+  649 --     worker i acc (x:y:xs) =
+  650 --       let xy = approxDist x y in
+  651 --       if acc + xy > limit
+  652 --         then x : worker (i-1) 0 (lerp ((limit-acc)/xy) y x : y:xs)
+  653 --         else x : worker i (acc+xy) (y:xs)
+  654 --     worker _ _ [_] = []
+  655 --     worker _ _ _ = error "addPoints: invalid polygon"
+  656 --     s = pSize p
+  657 --     len = polygonLength p
+  658 --     limit = len / fromIntegral (n+1)
+  659 
+  660 pIsConvex :: Polygon -> Bool
+  661 pIsConvex p = and
+  662   [ area2X (pAccess p i) (pAccess p j) (pAccess p k) > 0
+  663   | i <- [0..n-1]
+  664   , j <- [i+1..n-1]
+  665   , k <- [j+1..n-1]
+  666   ]
+  667   where n = pSize p
+  668 
+  669 pIsCCW :: Polygon -> Bool
+  670 pIsCCW p | pNull p = False
+  671 pIsCCW p = V.sum (pMapEdges fn p) < 0
+  672   where
+  673     fn (V2 x1 y1) (V2 x2 y2) = (x2-x1)*(y2+y1)
+  674 
+  675 {-# INLINE pRayIntersect #-}
+  676 pRayIntersect :: PolyCtx a => APolygon a -> (Int, Int) -> (Int,Int) -> Maybe (V2 a)
+  677 pRayIntersect p (a,b) (c,d) =
+  678   rayIntersect (pAccess p a, pAccess p b) (pAccess p c, pAccess p d)
+  679 
+  680 pCuts :: (Real a, Fractional a, Epsilon a) => APolygon a -> [(APolygon a,APolygon a)]
+  681 pCuts p =
+  682   [ pCutAt (pAdjustOffset p i) (j-i)
+  683   | i <- [0 .. pSize p-1 ]
+  684   , j <- [i+2 .. pSize p-1 ]
+  685   , (j+1) `mod` pSize p /= i
+  686   , pParent p i j == i ]
+  687 
+  688 pCutEqual :: PolyCtx a => APolygon a -> (APolygon a, APolygon a)
+  689 pCutEqual p =
+  690     fromMaybe (p,p) $ listToMaybe $ sortOn f $ pCuts p
+  691   where
+  692     f (a,b) = abs (pArea a - pArea b)
+  693 
+  694 -- FIXME: This should be more efficient
+  695 pCutAt :: PolyCtx a => APolygon a -> Int -> (APolygon a, APolygon a)
+  696 pCutAt p i = (mkPolygon $ V.fromList left, mkPolygon $ V.fromList right)
+  697   where
+  698     n     = pSize p
+  699     left  = map (pAccess p) [0 .. i]
+  700     right = map (pAccess p) (0:[i..n-1])
+  701 
+  702 pOverlap :: PolyCtx a => APolygon a -> APolygon a -> APolygon a
+  703 pOverlap a b = mkPolygon $ V.fromList $ clearDups $ concatMap edgeIntersect [0 .. pSize a-1]
+  704   where
+  705     clearDups (x:y:xs)
+  706       | x == y = clearDups (y:xs)
+  707       | otherwise = x : clearDups (y:xs)
+  708     clearDups xs = xs
+  709     edgeIntersect edge =
+  710       sortOn (distSquared (pAccess a edge)) $ catMaybes
+  711       [ lineIntersect (aP, aP') (bP, bP')
+  712       | i <- [0 .. pSize b-1]
+  713       , let aP = pAccess a edge
+  714             aP' = pAccess a (edge+1)
+  715             bP = pAccess b i
+  716             bP' = pAccess b (i+1)
+  717       ]
+  718 
+  719 ---------------------------------------------------------
+  720 -- SSSP visibility and SSSP windows
+  721 
+  722 ssspVisibility :: PolyCtx a => APolygon a -> APolygon a
+  723 ssspVisibility p = mkPolygon $
+  724     V.fromList $ clearDups $ go [0 .. pSize p-1] -- ([root..pSize p-1]  ++ [0 .. root-1])
+  725   where
+  726     clearDups (x:y:xs)
+  727       | x == y = clearDups (y:xs)
+  728       | otherwise = x : clearDups (y:xs)
+  729     clearDups xs = xs
+  730     obstructedBy n =
+  731       case pParent p 0 n of
+  732         0 -> n
+  733         i -> obstructedBy i
+  734     go [] = []
+  735     go [x] = [pAccess p x]
+  736     go (x:y:xs) =
+  737       let xO = obstructedBy x
+  738           yO = obstructedBy y
+  739       in case () of
+  740           ()
+  741             -- Both ends are visible.
+  742             | xO == x && yO == y -> pAccess p x : go (y:xs)
+  743             -- X is visible, x to intersect (0,yO) (x,y)
+  744             | xO == x   ->
+  745               pAccess p x : fromMaybe (pAccess p y) (pRayIntersect p (0,yO) (x,y)) : go (y:xs)
+  746             -- Y is visible
+  747             | yO == y   -> fromMaybe (pAccess p x) (pRayIntersect p (0,xO) (x,y)) : pAccess p y : go (y:xs)
+  748             -- Neither is visible and they've obstructed by the same point
+  749             -- so the entire edge is hidden.
+  750             | xO == yO -> go (y:xs)
+  751             -- Neither is visible. Cast shadow from obstruction points to
+  752             -- find if a subsection of the edge is visible.
+  753             | otherwise ->
+  754               let a = fromMaybe (error "a") (pRayIntersect p (0,xO) (x,y))
+  755                   b = fromMaybe (error "b") (pRayIntersect p (0,yO) (x,y))
+  756               in if a /= b
+  757                 then a : b : go (y:xs)
+  758                 else go (y:xs)
+  759 
+  760 ssspWindows :: Polygon -> [(V2 Rational, V2 Rational)]
+  761 ssspWindows p = clearDups $ go (pAccess p 0) [0..pSize p-1]
+  762   where
+  763     clearDups (x:y:xs)
+  764       | x == y = clearDups (y:xs)
+  765       | otherwise = x : clearDups (y:xs)
+  766     clearDups xs = xs
+  767     obstructedBy n =
+  768       case pParent p 0 n of
+  769         0 -> n
+  770         i -> obstructedBy i
+  771     go _ [] = []
+  772     go _ [_] = []
+  773     go l (x:y:xs) =
+  774       let xO = obstructedBy x
+  775           yO = obstructedBy y
+  776       in case () of
+  777           ()
+  778             -- Both ends are visible.
+  779             | xO == x && yO == y -> go (pAccess p x) (y:xs)
+  780             -- X is visible, x to intersect (0,yO) (x,y)
+  781             | xO == x   ->
+  782               go (fromMaybe (pAccess p y) (pRayIntersect p (0,yO) (x,y))) (y:xs)
+  783             -- Y is visible
+  784             | yO == y   ->
+  785               let newL = fromMaybe (pAccess p x) (pRayIntersect p (0,xO) (x,y)) in
+  786               (l, newL) :
+  787               go newL (y:xs)
+  788             -- Neither is visible and they've obstructed by the same point
+  789             -- so the entire edge is hidden.
+  790             | xO == yO -> go l (y:xs)
+  791             -- Neither is visible. Cast shadow from obstruction points to
+  792             -- find if a subsection of the edge is visible.
+  793             | otherwise ->
+  794               let a = fromMaybe (error "a") (pRayIntersect p (0,xO) (x,y))
+  795                   b = fromMaybe (error "b") (pRayIntersect p (0,yO) (x,y))
+  796               in if a /= b
+  797                 then (l, a) : (b, pAccess p yO) : go (pAccess p yO) (y:xs)
+  798                 else go l (y:xs)
+  799 
+  800 pdualPolygons :: Polygon -> PDual -> [Polygon]
+  801 pdualPolygons p pdual = map mkPolygonFromRing (pdualRings (pRing p) pdual)
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Math.SSSP.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Math.SSSP.hs.html new file mode 100644 index 0000000..4ff5029 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Math.SSSP.hs.html @@ -0,0 +1,366 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE FlexibleInstances     #-}
+    2 {-# LANGUAGE MultiParamTypeClasses #-}
+    3 {-# OPTIONS_GHC -fno-warn-orphans #-}
+    4 {-# OPTIONS_HADDOCK hide #-}
+    5 module Reanimate.Math.SSSP
+    6   ( -- * Single-Source-Shortest-Path
+    7     SSSP
+    8   , sssp                -- :: (Fractional a, Ord a) => Ring a -> Dual -> SSSP
+    9   , dual                -- :: Int -> Triangulation -> Dual
+   10   , Dual(..)
+   11   , DualTree(..)
+   12   , PDual
+   13   , toPDual             -- :: Ring Rational -> Dual -> PDual
+   14   , pdualRings          -- :: Ring Rational -> PDual -> [Ring Rational]
+   15     -- * Misc
+   16   , dualToTriangulation -- :: Ring Rational -> Dual -> Triangulation
+   17   , pdualReduce         -- :: Ring Rational -> PDual -> Int -> PDual
+   18   , visibilityArray     -- :: Ring Rational -> V.Vector [Int]
+   19   , naive               -- :: Ring Rational -> SSSP
+   20   , naive2              -- :: Ring Rational -> SSSP
+   21   , drawDual            -- :: Dual -> String
+   22   ) where
+   23 
+   24 import           Control.Monad
+   25 -- import           Control.Exception
+   26 import           Control.Monad.ST
+   27 -- import           Data.FingerTree            (SearchResult (..), (|>))
+   28 -- import qualified Data.FingerTree            as F
+   29 import           Data.Foldable
+   30 import           Data.List
+   31 import qualified Data.Map                   as Map
+   32 import           Data.Maybe
+   33 import           Data.Ord
+   34 import           Data.STRef
+   35 import           Data.Tree
+   36 import qualified Data.Vector                as V
+   37 import qualified Data.Vector.Mutable        as MV
+   38 import           Reanimate.Math.Common
+   39 import           Reanimate.Math.Triangulate
+   40 
+   41 -- import           Debug.Trace
+   42 
+   43 type SSSP = V.Vector Int
+   44 
+   45 
+   46 -- ssspParent :: Polygon -> SSSP -> Int -> Int
+   47 -- ssspParent p sTree x =
+   48 --     (sTree V.! ((x - polygonOffset p) `mod` n) + polygonOffset p) `mod` n
+   49 --   where
+   50 --     n = polygonSize p
+   51 
+   52 visibilityArray :: Ring Rational -> V.Vector [Int]
+   53 visibilityArray p = arr
+   54   where
+   55     n = ringSize p
+   56     arr = V.fromList
+   57         [ visibility y
+   58         | y <- [0..n-1]
+   59         ]
+   60     visibility y =
+   61       [ i
+   62       | i <- [0..y-1]
+   63       , y `elem` arr V.! i ] ++
+   64       [ i
+   65       | i <- [y+1 .. n-1]
+   66       , let pI = ringAccess p i
+   67             isOpen = isRightTurn pYp pY pYn
+   68       , ringClamp p (y+1) == i || ringClamp p (y-1) == i || if isOpen
+   69         then isLeftTurnOrLinear pY pYn pI ||
+   70              isLeftTurnOrLinear pYp pY pI
+   71         else not $ isRightTurn pY pYn pI ||
+   72                    isRightTurn pYp pY pI
+   73       , let myEdges = [(e1,e2) | (e1,e2) <- edges, e1/=y, e1/=i, e2/=y,e2/=i]
+   74       , all (isNothing . lineIntersect (pY,pI))
+   75               [ (ringAccess p e1, ringAccess p e2) | (e1,e2) <- myEdges ]]
+   76       where
+   77         pY = ringAccess p y
+   78         pYn = ringAccess p $ y+1
+   79         pYp = ringAccess p $ y-1
+   80         edges = zip [0..n-1] (tail [0..n-1] ++ [0])
+   81 
+   82 
+   83 
+   84 -- Iterative Single Source Shortest Path solver. Quite slow.
+   85 naive :: Ring Rational -> SSSP
+   86 naive p =
+   87     V.fromList $ Map.elems $
+   88     Map.map snd $
+   89     worker initial
+   90   where
+   91     initial = Map.singleton 0 (0,0)
+   92     visibility = visibilityArray p
+   93     worker :: Map.Map Int (Rational, Int) -> Map.Map Int (Rational, Int)
+   94     worker m
+   95         | m==newM   = newM
+   96         | otherwise = worker newM
+   97       where
+   98         ms' = [ Map.fromList
+   99                     [ case Map.lookup v m of
+  100                         Nothing -> (v, (distThroughI, i))
+  101                         Just (otherDist,parent)
+  102                           | otherDist > distThroughI -> (v, (distThroughI, i))
+  103                           | otherwise -> (v, (otherDist, parent))
+  104                     | v <- visibility V.! i
+  105                     , let distThroughI = dist + approxDist (ringAccess p i) (ringAccess p v) ]
+  106               | (i,(dist,_)) <- Map.toList m
+  107               ]
+  108         newM = Map.unionsWith g (m:ms') :: Map.Map Int (Rational,Int)
+  109     g a b = if fst a < fst b then a else b
+  110 
+  111 naive2 :: Ring Rational -> SSSP
+  112 naive2 p = runST $ do
+  113     parents <- MV.replicate (ringSize p) (-1)
+  114     costs <- MV.replicate (ringSize p) (-1)
+  115     MV.write parents 0 0
+  116     MV.write costs 0 0
+  117     changedRef <- newSTRef False
+  118     let loop i
+  119           | i == ringSize p = do
+  120             changed <- readSTRef changedRef
+  121             when changed $ do
+  122               writeSTRef changedRef False
+  123               loop 0
+  124           | otherwise = do
+  125             myCost <- MV.read costs i
+  126             unless (myCost < 0) $
+  127               forM_ (visibility V.! i) $ \n -> do
+  128                 -- n is visible from i.
+  129                 theirCost <- MV.read costs n
+  130                 let throughCost = myCost + approxDist (ringAccess p i) (ringAccess p n)
+  131                 when (throughCost < theirCost || theirCost < 0) $ do
+  132                     MV.write parents n i
+  133                     MV.write costs n throughCost
+  134                     writeSTRef changedRef True
+  135             loop (i+1)
+  136     loop 0
+  137     V.unsafeFreeze parents
+  138   where
+  139     visibility = visibilityArray p
+  140 
+  141 data PDual = PDual (V.Vector Int) Rational [PDual]
+  142   deriving (Show)
+  143 
+  144 toPDual :: Ring Rational -> Dual -> PDual
+  145 toPDual p d =
+  146   case d of
+  147     Dual (a,b,c) l r ->
+  148       PDual (V.fromList [a,b,c])
+  149         (area2X (ringAccess p a) (ringAccess p b) (ringAccess p c))
+  150         (catMaybes [ worker c a l, worker b c r])
+  151   where
+  152     worker _ _ EmptyDual = Nothing
+  153     worker a b (NodeDual x l r) = Just $
+  154       PDual (V.fromList [a,x,b])
+  155         (area2X (ringAccess p a) (ringAccess p x) (ringAccess p b))
+  156         (catMaybes [ worker x b l, worker a x r])
+  157 
+  158 pdualSize :: PDual -> Int
+  159 pdualSize (PDual _ _ children) = 1 + sum (map pdualSize children)
+  160 
+  161 pdualArea :: PDual -> Rational
+  162 pdualArea (PDual _ faceArea _) = faceArea
+  163 
+  164 -- FIXME: 'origin' isn't used. Remove.
+  165 pdualReduce :: Ring Rational -> PDual -> Int -> PDual
+  166 pdualReduce origin pdual n
+  167   | pdualSize pdual <= n = pdual
+  168   | otherwise =
+  169     let smallest = minimum $ pAreas pdual
+  170     in pdualReduce origin (merge smallest pdual) n
+  171   where
+  172     merge _s (PDual p faceArea []) = PDual p faceArea []
+  173     merge s (PDual p faceArea children)
+  174       | faceArea == s =
+  175         let (PDual p2 area2 children2:xs) = sortBy (comparing pdualArea) children
+  176         in PDual (joinP p p2) (faceArea+area2) (children2++xs)
+  177       | otherwise =
+  178         let (PDual p2 area2 children2:xs) = sortBy (comparing pdualArea) children
+  179         in if area2 == s
+  180             then PDual (joinP p p2) (faceArea+area2) (children2++xs)
+  181             else PDual p faceArea (map (merge s) children)
+  182     pAreas (PDual _ faceArea children) = faceArea : concatMap pAreas children
+  183     joinP a b = V.fromList (sort (V.toList a ++ V.toList b))
+  184 
+  185 pdualRings :: Ring Rational -> PDual -> [Ring Rational]
+  186 pdualRings p (PDual pts _area children) =
+  187   ringPack (V.map (ringAccess p) pts) : concatMap (pdualRings p) children
+  188 
+  189 -- Dual of triangulated polygon
+  190 data Dual = Dual (Int,Int,Int) -- (a,b,c)
+  191                   DualTree -- borders ca
+  192                   DualTree -- borders bc
+  193   deriving (Show)
+  194 
+  195 data DualTree
+  196   = EmptyDual
+  197   | NodeDual Int -- axb triangle, a and b are from parent.
+  198       DualTree -- borders xb
+  199       DualTree -- borders ax
+  200   deriving (Show)
+  201 
+  202 drawDual :: Dual -> String
+  203 drawDual d = drawTree $
+  204   case d of
+  205     Dual (a,b,c) l r -> Node (show (a,b,c)) [worker c a l, worker b c r]
+  206   where
+  207     worker _a _b EmptyDual = Node "Leaf" []
+  208     worker a b (NodeDual x l r) =
+  209       Node (show (b,a,x)) [worker x b l, worker a x r]
+  210 
+  211 dualToTriangulation :: Ring Rational -> Dual -> Triangulation
+  212 dualToTriangulation p d = edgesToTriangulation (ringSize p) $ filter goodEdge $
+  213     case d of
+  214       Dual (a,b,c) l r ->
+  215         (a,b):(a,c):(b,c):worker c a l ++ worker b c r
+  216   where
+  217     goodEdge (a,b)
+  218       = a /= ringClamp p (b+1) && a /= ringClamp p (b-1)
+  219     worker _a _b EmptyDual = []
+  220     worker a b (NodeDual x l r) =
+  221       (a,x) : (x, b) : worker x b l ++ worker a x r
+  222 
+  223 -- Dual path:
+  224 -- (Int,Int,Int) + V.Vector Int + V.Vector LeftOrRight
+  225 
+  226 -- simplifyDual :: DualTree -> DualTree
+  227 -- -- simplifyDual (NodeDual x EmptyDual EmptyDual) = NodeLeaf x
+  228 -- -- simplifyDual (NodeDual x l EmptyDual) = NodeDualL x l
+  229 -- -- simplifyDual (NodeDual x EmptyDual r) = NodeDualR x r
+  230 -- simplifyDual d = d
+  231 
+  232 dual :: Int -> Triangulation -> Dual
+  233 dual root t =
+  234   case hasTriangle of
+  235     []    -> error "weird triangulation"
+  236     -- [] -> Dual (0,1,V.length t-1) EmptyDual (dualTree t (1, (V.length t-1)) 0)
+  237     (x:_) -> Dual (root,rootNext,x) (dualTree t (x,root) rootNext) (dualTree t (rootNext,x) root)
+  238   where
+  239     rootNext = idx (root+1)
+  240     rootPrev = idx (root-1)
+  241     rootNNext = idx (root+2)
+  242     idx i = i `mod` n
+  243     hasTriangle = (rootPrev : t V.! root) `intersect` (rootNNext : t V.! rootNext)
+  244     n = V.length t
+  245 
+  246 -- a=6, b=0, e=1
+  247 dualTree :: Triangulation -> (Int,Int) -> Int -> DualTree
+  248 dualTree t (a,b) e = -- simplifyDual $
+  249     case hasTriangle of
+  250       [] -> EmptyDual
+  251       [(ab)] ->
+  252         NodeDual ab
+  253           (dualTree t (ab,b) a)
+  254           (dualTree t (a,ab) b)
+  255       _ -> error $ "Invalid triangulation: " ++ show (a,b,e,hasTriangle)
+  256   where
+  257     hasTriangle = (prev a : next a : t V.! a) `intersect` (prev b : next b : t V.! b)
+  258       \\ [e]
+  259     n = V.length t
+  260     next x = (x+1) `mod` n
+  261     prev x = (x-1) `mod` n
+  262 
+  263 -- data MinMax = MinMax Int Int | MinMaxEmpty deriving (Show)
+  264 -- instance Semigroup MinMax where
+  265 --   MinMaxEmpty <> b = b
+  266 --   a <> MinMaxEmpty = a
+  267 --   MinMax a b <> MinMax c d
+  268 --     = MinMax (min a c) (max b d)
+  269 --     -- = MinMax c b
+  270 -- instance Monoid MinMax where
+  271 --   mempty = MinMaxEmpty
+  272 --
+  273 -- instance F.Measured MinMax Int where
+  274 --   measure i = MinMax i i
+  275 
+  276 -- dualRoot :: Dual -> Int
+  277 -- dualRoot (Dual (a,_,_) _ _) = a
+  278 
+  279 -- O(n*ln n), could be O(n) if I could figure out how to use fingertrees...
+  280 sssp :: (Fractional a, Ord a, Epsilon a) => Ring a -> Dual -> SSSP
+  281 sssp p d = toSSSP $
+  282     case d of
+  283       Dual (a,b,c) l r ->
+  284         (a, a) :
+  285         (b, a) :
+  286         (c, a) :
+  287         worker [c] [b] a r ++
+  288         loopLeft a c l
+  289   where
+  290     toSSSP edges =
+  291       (V.fromList . map snd . sortOn fst) edges
+  292     loopLeft a outer l =
+  293       case l of
+  294         EmptyDual -> []
+  295         NodeDual x l' r' ->
+  296           (x,a) :
+  297           worker [x] [outer] a r' ++
+  298           loopLeft a x l'
+  299     searchFn _checkStep _cusp _x [] = Nothing
+  300     searchFn checkStep cusp x (y:ys)
+  301       | not (checkStep (ringAccess p cusp) (ringAccess p y) (ringAccess p x))
+  302         = Just $ helper [] y ys
+  303       | otherwise = Nothing
+  304       where
+  305         helper acc v [] = (v, [], reverse acc)
+  306         helper acc v1 (v2:vs)
+  307           | checkStep (ringAccess p v1) (ringAccess p v2) (ringAccess p x) =
+  308             (v1, v2:vs, reverse acc)
+  309           | otherwise = helper (v1:acc) v2 vs
+  310     searchRight = searchFn isLeftTurn
+  311     searchLeft = searchFn isRightTurn
+  312     -- adj x = x -- ringClamp p (x-dualRoot d)
+  313     -- optTrace msg =
+  314     --   if False -- dualRoot d == 1 || dualRoot d == 0
+  315     --     then trace msg
+  316     --     else id
+  317     worker _ _ _ EmptyDual = []
+  318     worker f1 f2 cusp (NodeDual x l r) =
+  319         -- (optTrace ("Funnel: " ++ show
+  320         --       (map adj $ toList f1
+  321         --       ,adj cusp
+  322         --       ,map adj $ toList f2
+  323         --       ,adj x
+  324         --       , dualRoot d))
+  325         --   ) $
+  326         case searchLeft cusp x (toList f1) of
+  327           Just (v, f1Hi, f1Lo) ->
+  328                 -- optTrace ("  Visble from left: " ++ show (adj x,adj v)) $
+  329                 (x, v::Int) :
+  330                 worker f1Hi [x] v l ++
+  331                 worker (f1Lo ++ [v, x]) f2 cusp r
+  332           Nothing ->
+  333             case searchRight cusp x (toList f2) of
+  334               Just (v, f2Hi, f2Lo) ->
+  335                 -- optTrace ("  Visble from right: " ++ show (adj x,adj v)) $
+  336                 (x, v::Int) :
+  337                 worker f1 (f2Lo ++ [v, x]) cusp l ++
+  338                 worker [x] f2Hi v r
+  339               Nothing ->
+  340                 -- optTrace ("  Visble from cusp: " ++ show (adj x,adj cusp)) $
+  341                 (x, cusp::Int) :
+  342                 worker f1 [x] cusp l ++
+  343                 worker [x] f2 cusp r
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Math.Triangulate.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Math.Triangulate.hs.html new file mode 100644 index 0000000..fe4995c --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Math.Triangulate.hs.html @@ -0,0 +1,108 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE DataKinds           #-}
+    2 {-# LANGUAGE ScopedTypeVariables #-}
+    3 {-# OPTIONS_HADDOCK hide #-}
+    4 module Reanimate.Math.Triangulate
+    5   ( Triangulation
+    6   , edgesToTriangulation
+    7   , edgesToTriangulationM
+    8   , trianglesToTriangulation
+    9   , trianglesToTriangulationM
+   10   , triangulate
+   11   )
+   12 where
+   13 
+   14 import           Algorithms.Geometry.PolygonTriangulation.Triangulate (triangulate')
+   15 import           Algorithms.Geometry.PolygonTriangulation.Types
+   16 import           Control.Lens
+   17 import           Control.Monad
+   18 import           Control.Monad.ST
+   19 import           Data.Ext
+   20 import           Data.Geometry.PlanarSubdivision                      (PolygonFaceData)
+   21 import           Data.Geometry.Point
+   22 import           Data.Geometry.Polygon
+   23 import qualified Data.IntSet                                          as ISet
+   24 import qualified Data.PlaneGraph as Geo
+   25 import           Data.Proxy
+   26 import qualified Data.Vector                                          as V
+   27 import qualified Data.Vector.Mutable                                  as MV
+   28 import           Linear.V2
+   29 import           Reanimate.Math.Common
+   30 -- Max edges: n-2
+   31 -- Each edge is represented twice: 2n-4
+   32 -- Flat structure:
+   33 --   edges   :: V.Vector Int -- max length (2n-4)
+   34 --   offsets :: V.Vector Int -- length n
+   35 -- Combine the two vectors? < n => offsets, >= n => edges?
+   36 type Triangulation = V.Vector [Int]
+   37 
+   38 -- FIXME: Move to Common or a Triangulation module
+   39 -- O(n)
+   40 edgesToTriangulation :: Int -> [(Int, Int)] -> Triangulation
+   41 edgesToTriangulation size edges = runST $ do
+   42   v <- edgesToTriangulationM size edges
+   43   V.unsafeFreeze v
+   44 
+   45 edgesToTriangulationM :: Int -> [(Int, Int)] -> ST s (V.MVector s [Int])
+   46 edgesToTriangulationM size edges = do
+   47   v <- MV.replicate size []
+   48   forM_ edges $ \(e1, e2) -> do
+   49     MV.modify v (e1 :) e2
+   50     MV.modify v (e2 :) e1
+   51   forM_ [0 .. size - 1] $ \i -> MV.modify v (ISet.toList . ISet.fromList) i
+   52   return v
+   53 
+   54 trianglesToTriangulation :: Int -> V.Vector (Int, Int, Int) -> Triangulation
+   55 trianglesToTriangulation size edges = runST $ do
+   56   v <- trianglesToTriangulationM size edges
+   57   V.unsafeFreeze v
+   58 
+   59 trianglesToTriangulationM
+   60   :: Int -> V.Vector (Int, Int, Int) -> ST s (V.MVector s [Int])
+   61 trianglesToTriangulationM size trigs = do
+   62   v <- MV.replicate size []
+   63   forM_ (V.toList trigs) $ \(a, b, c) -> do
+   64     MV.modify v (\x -> b : c : x) a
+   65     MV.modify v (\x -> a : c : x) b
+   66     MV.modify v (\x -> a : b : x) c
+   67   forM_ [0 .. size - 1] $ \i -> MV.modify v (ISet.toList . ISet.fromList) i
+   68   return v
+   69 
+   70 
+   71 triangulate :: forall a. (Fractional a, Ord a) => Ring a -> Triangulation
+   72 triangulate r = edgesToTriangulation (ringSize r) ds
+   73   where
+   74     ds :: [(Int,Int)]
+   75     ds =
+   76       [ (a^.Geo.vData, b^.Geo.vData)
+   77       | (d, Diagonal) <- V.toList (Geo.edges pg)
+   78       , let (a,b) = Geo.endPointData d pg ]
+   79     pg :: Geo.PlaneGraph () Int PolygonEdgeType PolygonFaceData a
+   80     pg = triangulate' Proxy p
+   81     p :: SimplePolygon Int a
+   82     p = fromPoints $
+   83       [ Point2 x y :+ n
+   84       | (n,V2 x y) <- zip [0..] (V.toList (ringUnpack r)) ]
+   85     -- ringUnpack
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Misc.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Misc.hs.html new file mode 100644 index 0000000..7a10433 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Misc.hs.html @@ -0,0 +1,131 @@ + + + + + + +
+never executed always true always false
+
+
+    1 module Reanimate.Misc
+    2   ( requireExecutable
+    3   , runCmd
+    4   , runCmd_
+    5   , runCmdLazy
+    6   , withTempDir
+    7   , withTempFile
+    8   , renameOrCopyFile
+    9   ) where
+   10 
+   11 import           Control.Concurrent
+   12 import           Control.Exception  (catch, evaluate, finally, throw)
+   13 import qualified Data.Text          as T
+   14 import qualified Data.Text.IO       as T
+   15 import           Foreign.C.Error
+   16 import           GHC.IO.Exception
+   17 import           System.Directory   (copyFile, findExecutable, removeFile,
+   18                                      renameFile)
+   19 import           System.FilePath    ((<.>))
+   20 import           System.IO          (hClose, hGetContents, hIsEOF, hPutStr,
+   21                                      stderr)
+   22 import           System.IO.Temp     (withSystemTempDirectory,
+   23                                      withSystemTempFile)
+   24 import           System.Process     (readProcessWithExitCode,
+   25                                      runInteractiveProcess, showCommandForUser,
+   26                                      terminateProcess, waitForProcess)
+   27 
+   28 
+   29 requireExecutable :: String -> IO FilePath
+   30 requireExecutable exec = do
+   31   mbPath <- findExecutable exec
+   32   case mbPath of
+   33     Nothing   -> error $ "Couldn't find executable: " ++ exec
+   34     Just path -> return path
+   35 
+   36 runCmd :: FilePath -> [String] -> IO ()
+   37 runCmd exec args = do
+   38   ret <- runCmd_ exec args
+   39   case ret of
+   40     Left err -> error $ showCommandForUser exec args ++ ":\n" ++ err
+   41     Right{}  -> return ()
+   42 
+   43 runCmd_ :: FilePath -> [String] -> IO (Either String String)
+   44 runCmd_ exec args = do
+   45   (ret, stdout, errMsg) <- readProcessWithExitCode exec args ""
+   46   _                     <- evaluate (length stdout + length errMsg)
+   47   case ret of
+   48     ExitSuccess -> return (Right stdout)
+   49     ExitFailure err | False ->
+   50       return
+   51         $  Left
+   52         $  "Failed to run: "
+   53         ++ showCommandForUser exec args
+   54         ++ "\n"
+   55         ++ "Error code: "
+   56         ++ show err
+   57         ++ "\n"
+   58         ++ "stderr: "
+   59         ++ errMsg
+   60     ExitFailure{} | null errMsg -> -- LaTeX prints errors to stdout. :(
+   61       return $ Left stdout
+   62     ExitFailure{} -> return $ Left errMsg
+   63 
+   64 runCmdLazy
+   65   :: FilePath -> [String] -> (IO (Either String T.Text) -> IO a) -> IO a
+   66 runCmdLazy exec args handler = do
+   67   (inp, out, err, pid) <- runInteractiveProcess exec args Nothing Nothing
+   68   hClose inp
+   69   errOutput <- hGetContents err
+   70   _ <- forkIO $ hPutStr stderr errOutput
+   71   let fetch = do
+   72         eof <- hIsEOF out
+   73         if eof
+   74           then do
+   75             _      <- evaluate (length errOutput)
+   76             ret    <- waitForProcess pid
+   77             case ret of
+   78               ExitSuccess   -> return (Left "")
+   79               ExitFailure{} -> return (Left errOutput)
+   80               {-ExitFailure errMsg -> do
+   81                 return $ Left $
+   82                   "Failed to run: " ++ showCommandForUser exec args ++ "\n" ++
+   83                   "Error code: " ++ show errMsg ++ "\n" ++
+   84                   "stderr: " ++ stderr-}
+   85           else do
+   86             line <- T.hGetLine out
+   87             return (Right line)
+   88   handler fetch `finally` do
+   89     terminateProcess pid
+   90     _ <- waitForProcess pid
+   91     return ()
+   92 
+   93 -- renameFile fails if we're crossing filesystem boundaries. If this happens,
+   94 -- revert back to copyFile + removeFile.
+   95 renameOrCopyFile :: FilePath -> FilePath -> IO ()
+   96 renameOrCopyFile src dst = renameFile src dst `catch` exdev
+   97  where
+   98   exdev e = if fmap Errno (ioe_errno e) == Just eXDEV
+   99     then copyFile src dst >> removeFile src
+  100     else throw e
+  101 
+  102 withTempDir :: (FilePath -> IO a) -> IO a
+  103 withTempDir = withSystemTempDirectory "reanimate"
+  104 
+  105 withTempFile :: String -> (FilePath -> IO a) -> IO a
+  106 withTempFile ext action =
+  107   withSystemTempFile ("reanimate" <.> ext) $ \path hd ->
+  108     hClose hd >> action path
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Morph.Cache.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Morph.Cache.hs.html new file mode 100644 index 0000000..595a66d --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Morph.Cache.hs.html @@ -0,0 +1,66 @@ + + + + + + +
+never executed always true always false
+
+
+    1 module Reanimate.Morph.Cache
+    2   ( cachePointCorrespondence -- :: Int -> PointCorrespondence -> PointCorrespondence
+    3   ) where
+    4 
+    5 import           Control.Exception
+    6 import qualified Data.ByteString        as B
+    7 import           Data.Hashable
+    8 import           Data.Serialize
+    9 import           Reanimate.Cache        (encodeInt)
+   10 import           Reanimate.Misc         (renameOrCopyFile)
+   11 import           Reanimate.Morph.Common
+   12 import           System.Directory
+   13 import           System.FilePath
+   14 import           System.IO
+   15 import           System.IO.Temp
+   16 import           System.IO.Unsafe
+   17 
+   18 -- type PointCorrespondence = Polygon → Polygon → (Polygon, Polygon)
+   19 cachePointCorrespondence :: Int -> PointCorrespondence -> PointCorrespondence
+   20 cachePointCorrespondence ident fn src dst = unsafePerformIO $ do
+   21     root <- getXdgDirectory XdgCache "reanimate"
+   22     createDirectoryIfMissing True root
+   23     let path = root </> template
+   24     hit <- doesFileExist path
+   25     if hit
+   26       then do
+   27         inp <- B.readFile path
+   28         case decode inp of
+   29           Left{} -> do
+   30             removeFile path
+   31             gen path
+   32           Right out -> return out
+   33       else gen path
+   34   where
+   35     gen path = do
+   36       correspondence <- evaluate (fn src dst)
+   37       withSystemTempFile template $ \tmp h -> do
+   38         hClose h
+   39         B.writeFile tmp (encode correspondence)
+   40         renameOrCopyFile tmp path
+   41       return correspondence
+   42     template = encodeInt key <.> "morph"
+   43     key = hashWithSalt ident (src,dst)
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Morph.Common.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Morph.Common.hs.html new file mode 100644 index 0000000..efbd008 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Morph.Common.hs.html @@ -0,0 +1,241 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE RecordWildCards #-}
+    2 {-# LANGUAGE TupleSections   #-}
+    3 {-# LANGUAGE UnicodeSyntax   #-}
+    4 {-|
+    5 Copyright   : Written by David Himmelstrup
+    6 License     : Unlicense
+    7 Maintainer  : lemmih@gmail.com
+    8 Stability   : experimental
+    9 Portability : POSIX
+   10 -}
+   11 module Reanimate.Morph.Common
+   12   ( PointCorrespondence
+   13   , Trajectory
+   14   , ObjectCorrespondence
+   15   , Morph(..)
+   16   , morph
+   17   , splitObjectCorrespondence
+   18   , dupObjectCorrespondence
+   19   , genesisObjectCorrespondence
+   20   , toShapes
+   21   , normalizePolygons
+   22   , annotatePolygons
+   23   , unsafeSVGToPolygon
+   24   ) where
+   25 
+   26 import           Control.Lens
+   27 import qualified Data.Vector               as V
+   28 import           Graphics.SvgTree          (DrawAttributes, Texture (..),
+   29                                             drawAttributes, fillColor,
+   30                                             fillOpacity, groupOpacity,
+   31                                             strokeColor, strokeOpacity)
+   32 import           Linear.V2
+   33 import           Reanimate.Animation
+   34 import           Reanimate.ColorComponents
+   35 import           Reanimate.Ease
+   36 import           Reanimate.Math.Polygon    (APolygon, Epsilon, Polygon,
+   37                                             mkPolygon, pAddPoints, pCentroid,
+   38                                             pCutEqual, pSize, polygonPoints)
+   39 import           Reanimate.PolyShape
+   40 import           Reanimate.Svg
+   41 
+   42 -- import Debug.Trace
+   43 
+   44 -- Correspondence
+   45 -- Trajectory
+   46 -- Color interpolation
+   47 -- Polygon holes
+   48 -- Polygon splitting
+   49 
+   50 -- Graphical polygon? FIXME: Come up with a better name.
+   51 type GPolygon = (DrawAttributes, Polygon)
+   52 
+   53 -- | Method determining how points in the source polygon align with
+   54 --   points in the target polygon.
+   55 type PointCorrespondence = Polygon → Polygon → (Polygon, Polygon)
+   56 
+   57 -- | Method for interpolating between two aligned polygons.
+   58 type Trajectory = (Polygon, Polygon) → (Double → Polygon)
+   59 
+   60 -- | Method for pairing sets of polygons.
+   61 type ObjectCorrespondence = [GPolygon] → [GPolygon] → [(GPolygon, GPolygon)]
+   62 
+   63 -- | Morphing strategy
+   64 data Morph = Morph
+   65   { morphTolerance            :: Double
+   66     -- ^ Morphing curves is not always possible and
+   67     --   sometimes shapes are reduced to polygons or meta-curves.
+   68     --   This parameter determined the accuracy of this transformation.
+   69   , morphColorComponents      :: ColorComponents
+   70     -- ^ Color components used for color interpolation. LAB is usually
+   71     --   the best option here.
+   72   , morphPointCorrespondence  :: PointCorrespondence
+   73     -- ^ Desired point-correspondence algorithm.
+   74   , morphTrajectory           :: Trajectory
+   75     -- ^ Desired interpolation algorithm.
+   76   , morphObjectCorrespondence :: ObjectCorrespondence
+   77     -- ^ Desired object-correspondence algorithm.
+   78   }
+   79 
+   80 {-# INLINE morph #-}
+   81 -- | Apply morphing strategy to interpolate between two SVG images.
+   82 morph :: Morph -> SVG -> SVG -> Double -> SVG
+   83 morph Morph{..} src dst = \t ->
+   84   case t of
+   85     -- 0 -> lowerTransformations src
+   86     -- 1 -> lowerTransformations dst
+   87     _ -> mkGroup
+   88           [ render (genPoints t)
+   89               & drawAttributes .~ genAttrs t
+   90           | (genAttrs, genPoints) <- gens
+   91           ]
+   92   where
+   93     render p = mkLinePathClosed
+   94         [ (x,y) | V2 x y <- map (fmap realToFrac) $ V.toList $ polygonPoints p ]
+   95     srcShapes = toShapes morphTolerance src
+   96     dstShapes = toShapes morphTolerance dst
+   97     pairs = morphObjectCorrespondence srcShapes dstShapes
+   98     gens =
+   99       [ (interpolateAttrs morphColorComponents srcAttr dstAttr, morphTrajectory arranged)
+  100       | ((srcAttr, srcPoly'), (dstAttr, dstPoly')) <- pairs
+  101       , let arranged = morphPointCorrespondence srcPoly' dstPoly'
+  102       ]
+  103 
+  104 -- | Add points to each polygon such that they end up with same size.
+  105 normalizePolygons :: (Real a, Fractional a, Epsilon a) => APolygon a -> APolygon a -> (APolygon a, APolygon a)
+  106 normalizePolygons src dst =
+  107     (pAddPoints (max 0 $ dstN-srcN) src
+  108     ,pAddPoints (max 0 $ srcN-dstN) dst)
+  109   where
+  110     srcN = pSize src
+  111     dstN = pSize dst
+  112 
+  113 interpolateAttrs :: ColorComponents -> DrawAttributes -> DrawAttributes -> Double -> DrawAttributes
+  114 interpolateAttrs colorComps src dst t =
+  115     src & fillColor .~ (interpColor <$> src^.fillColor <*> dst^.fillColor)
+  116         & strokeColor .~ (interpColor <$> src^.strokeColor <*> dst^.strokeColor)
+  117         & fillOpacity .~ (interpOpacity <$> src^.fillOpacity <*> dst^.fillOpacity)
+  118         & groupOpacity .~ (interpOpacity <$> src^.groupOpacity <*> dst^.groupOpacity)
+  119         & strokeOpacity .~ (interpOpacity <$> src^.strokeOpacity <*> dst^.strokeOpacity)
+  120   where
+  121     interpColor (ColorRef a) (ColorRef b) =
+  122       ColorRef $ interpolateRGBA8 colorComps a b t
+  123     -- interpolateColor (ColorRef a) FillNone = ColorRef a
+  124     interpColor a _ = a
+  125     interpOpacity a b = realToFrac (fromToS (realToFrac a) (realToFrac b) t)
+  126 
+  127 -- | Object-correspondence algorithm that spawn objects as necessary.
+  128 genesisObjectCorrespondence :: ObjectCorrespondence
+  129 genesisObjectCorrespondence left right =
+  130   case (left, right) of
+  131     ([] , []) -> []
+  132     ([], (y1,y2):ys) ->
+  133       ((y1,y2), (y1, emptyFrom y2 y2)) : genesisObjectCorrespondence [] ys
+  134     ((x1,x2):xs, []) ->
+  135       ((x1,x2), (x1, emptyFrom x2 x2)) : genesisObjectCorrespondence xs []
+  136     (x:xs, y:ys) ->
+  137       (x,y) : genesisObjectCorrespondence xs ys
+  138   where
+  139     emptyFrom a b = mkPolygon $ V.map (const $ pCentroid a) (polygonPoints b)
+  140 
+  141 -- | Object-correspondence algorithm that duplicate objects as necessary.
+  142 dupObjectCorrespondence :: ObjectCorrespondence
+  143 dupObjectCorrespondence left right =
+  144   case (left, right) of
+  145     (_, []) -> []
+  146     ([], _) -> []
+  147     ([x], [y]) ->
+  148       [(x,y)]
+  149     ([(x1,x2)], yShapes) ->
+  150       let x2s = replicate (length yShapes) x2
+  151       in dupObjectCorrespondence (map (x1,) x2s) yShapes
+  152     (xShapes, [(y1,y2)]) ->
+  153       let y2s = replicate (length xShapes) y2
+  154       in dupObjectCorrespondence xShapes (map (y1,) y2s)
+  155     (x:xs, y:ys) ->
+  156       (x, y) : dupObjectCorrespondence xs ys
+  157 
+  158 -- | Object-correspondence algorithm that splits objects in smaller pieces
+  159 --   as necessary.
+  160 splitObjectCorrespondence :: ObjectCorrespondence
+  161 -- splitObjectCorrespondence = dupObjectCorrespondence
+  162 splitObjectCorrespondence left right =
+  163   case (left, right) of
+  164     (_, []) -> []
+  165     ([], _) -> []
+  166     ([x], [y]) ->
+  167       [(x,y)]
+  168     ([(x1,x2)], yShapes) ->
+  169       let x2s = splitPolygon (length yShapes) x2
+  170       in splitObjectCorrespondence (map (x1,) x2s) yShapes
+  171     (xShapes, [(y1,y2)]) ->
+  172       let y2s = splitPolygon (length xShapes) y2
+  173       in splitObjectCorrespondence xShapes (map (y1,) y2s)
+  174     (x:xs, y:ys) ->
+  175       (x,y) : splitObjectCorrespondence xs ys
+  176 
+  177 splitPolygon :: Int -> Polygon -> [Polygon]
+  178 splitPolygon 1 p = [p]
+  179 splitPolygon n p =
+  180   let (a,b) = pCutEqual p
+  181   in splitPolygon (n`div`2) a ++ splitPolygon ((n+1)`div`2) b
+  182 
+  183 -- joinPairs :: Correspondence -> [(DrawAttributes, PolyShape)] -> [(DrawAttributes, PolyShape)]
+  184 --           -> [(DrawAttributes, DrawAttributes, [(RPoint, RPoint)])]
+  185 -- joinPairs _ _ [] = []
+  186 -- joinPairs _ [] _ = []
+  187 -- joinPairs corr [(x1,x2)] [(y1,y2)] =
+  188 --   [(x1,y1, corr x2 y2)]
+  189 -- joinPairs corr [(x1,x2)] yShapes =
+  190 --   let x2s = splitPolyShape 0.001 (length yShapes) x2
+  191 --   in joinPairs corr (map (x1,) x2s) yShapes
+  192 -- joinPairs corr xShapes [(y1,y2)] =
+  193 --   let y2s = reverse $ splitPolyShape 0.001 (length xShapes) y2
+  194 --   in joinPairs corr xShapes (map (y1,) y2s)
+  195 -- joinPairs corr ((x1,x2):xs) ((y1,y2):ys) =
+  196 --   (x1,y1, corr x2 y2) : joinPairs corr xs ys
+  197 -- joinPairs _ _ _ = []
+  198 
+  199 -- FIXME: sort by size, smallest to largest
+  200 -- | Extract shapes and their graphical attributes from an SVG node.
+  201 toShapes :: Double -> SVG -> [(DrawAttributes, Polygon)]
+  202 toShapes tol src =
+  203   [ (attrs, plToPolygon tol shape)
+  204   | (_, attrs, glyph) <- svgGlyphs $ lowerTransformations $ pathify src
+  205   , shape <- map mergePolyShapeHoles $ plGroupShapes $ svgToPolyShapes glyph
+  206   ]
+  207 
+  208 -- | Extract the first polygon in an SVG node. Will fail if there
+  209 --   are no acceptable shapes.
+  210 unsafeSVGToPolygon :: Double -> SVG -> Polygon
+  211 unsafeSVGToPolygon tol src = snd $ head $ toShapes tol src
+  212 
+  213 -- | Map over each polygon in an SVG node.
+  214 annotatePolygons :: (Polygon -> SVG) -> SVG -> SVG
+  215 annotatePolygons fn svg = mkGroup
+  216   [ fn poly & drawAttributes .~ attr
+  217   | (attr, poly) <- toShapes 0.001 svg
+  218   ]
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Morph.Linear.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Morph.Linear.hs.html new file mode 100644 index 0000000..4f966e1 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Morph.Linear.hs.html @@ -0,0 +1,114 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-|
+    2 Copyright   : Written by David Himmelstrup
+    3 License     : Unlicense
+    4 Maintainer  : lemmih@gmail.com
+    5 Stability   : experimental
+    6 Portability : POSIX
+    7 -}
+    8 module Reanimate.Morph.Linear
+    9   ( linear, rawLinear
+   10   , closestLinearCorrespondence
+   11   , closestLinearCorrespondenceA
+   12   , linearTrajectory
+   13   ) where
+   14 
+   15 import           Data.Hashable
+   16 import qualified Data.Vector            as V
+   17 import           Linear.Vector
+   18 import           Reanimate.ColorComponents
+   19 import           Reanimate.Math.Common
+   20 import           Reanimate.Math.Polygon
+   21 import           Reanimate.Morph.Cache
+   22 import           Reanimate.Morph.Common
+   23 
+   24 -- | Linear interpolation strategy.
+   25 --
+   26 --   Example:
+   27 --
+   28 --   > playThenReverseA $ pauseAround 0.5 0.5 $ mkAnimation 3 $ \t ->
+   29 --   >   withStrokeLineJoin JoinRound $
+   30 --   >   let src = scale 8 $ center $ latex "X"
+   31 --   >       dst = scale 8 $ center $ latex "H"
+   32 --   >   in morph linear src dst t
+   33 --
+   34 --   <<docs/gifs/doc_linear.gif>>
+   35 linear :: Morph
+   36 linear = rawLinear
+   37   { morphPointCorrespondence  =
+   38       cachePointCorrespondence (hash ("closest"::String))
+   39         closestLinearCorrespondence }
+   40 
+   41 -- | Linear interpolation strategy without realigning corners.
+   42 --   May give better results if the polygons are already aligned.
+   43 --   Usually gives worse results.
+   44 --
+   45 --   Example:
+   46 --
+   47 --   > playThenReverseA $ pauseAround 0.5 0.5 $ mkAnimation 3 $ \t ->
+   48 --   >   withStrokeLineJoin JoinRound $
+   49 --   >   let src = scale 8 $ center $ latex "X"
+   50 --   >       dst = scale 8 $ center $ latex "H"
+   51 --   >   in morph rawLinear src dst t
+   52 --
+   53 --   <<docs/gifs/doc_rawLinear.gif>>
+   54 rawLinear :: Morph
+   55 rawLinear = Morph
+   56   { morphTolerance            = 0.001
+   57   , morphColorComponents      = labComponents
+   58   , morphPointCorrespondence  = normalizePolygons
+   59   , morphTrajectory           = linearTrajectory
+   60   , morphObjectCorrespondence = splitObjectCorrespondence }
+   61 
+   62 -- | Cycle polygons until the sum of the point trajectory path lengths
+   63 --   is smallest.
+   64 closestLinearCorrespondence :: PointCorrespondence
+   65 closestLinearCorrespondence = closestLinearCorrespondenceA
+   66 
+   67 -- | Cycle polygons until the sum of the point trajectory path lengths
+   68 --   is smallest.
+   69 closestLinearCorrespondenceA :: (Real a, Fractional a, Epsilon a) => APolygon a -> APolygon a -> (APolygon a, APolygon a)
+   70 closestLinearCorrespondenceA src' dst' =
+   71     (src, worker dst (score dst) options)
+   72   where
+   73     (src, dst) = normalizePolygons src' dst'
+   74     worker bestP _bestPScore [] = bestP
+   75     worker bestP bestPScore (x:xs) =
+   76       let newScore = score x in
+   77       if newScore < bestPScore
+   78         then worker x newScore xs
+   79         else worker bestP bestPScore xs
+   80     options = pCycles dst
+   81     score p = sum
+   82       [ -- approxDist (pAccess src n) (pAccess p n)
+   83         distSquared (pAccess src n) (pAccess p n)
+   84       | n <- [0 .. pSize src-1] ]
+   85 
+   86 -- | Strategy for moving points in a linear (straight-line) trajectory.
+   87 linearTrajectory :: Trajectory
+   88 linearTrajectory (src,dst)
+   89   | pSize src == pSize dst = \t -> mkPolygon $
+   90     V.zipWith (lerp $ realToFrac t) (polygonPoints dst) (polygonPoints src)
+   91   | otherwise = error $ "Invalid lengths: " ++ show (pSize src, pSize dst)
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Parameters.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Parameters.hs.html new file mode 100644 index 0000000..7bf78d5 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Parameters.hs.html @@ -0,0 +1,145 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {- |
+    2   Parameters define the global context of an animation. They are set once
+    3   before an animation is rendered and may not change during rendering.
+    4 -}
+    5 module Reanimate.Parameters
+    6   ( Raster(..)
+    7   , Width
+    8   , Height
+    9   , FPS
+   10   , pRaster
+   11   , pFPS
+   12   , pWidth
+   13   , pHeight
+   14   , pNoExternals
+   15   , pRootDirectory
+   16   , setRaster
+   17   , setFPS
+   18   , setWidth
+   19   , setHeight
+   20   , setNoExternals
+   21   , setRootDirectory
+   22   ) where
+   23 
+   24 import System.IO.Unsafe
+   25 import Data.IORef
+   26 
+   27 -- | Width of animation in pixels.
+   28 type Width = Int
+   29 -- | Height of animation in pixels.
+   30 type Height = Int
+   31 -- | Framerate of animation in frames per second.
+   32 type FPS = Int
+   33 
+   34 -- | Raster engines turn SVG images into pixels.
+   35 data Raster
+   36   = RasterNone     -- ^ Do not use any external raster engine. Rely on the browser or ffmpeg.
+   37   | RasterAuto     -- ^ Scan for installed raster engines and pick the fastest one.
+   38   | RasterInkscape -- ^ Use Inkscape to raster SVG images.
+   39   | RasterRSvg     -- ^ Use rsvg-convert to raster SVG images.
+   40   | RasterMagick   -- ^ Use imagemagick to raster SVG images.
+   41   deriving (Show, Eq)
+   42 
+   43 {-# NOINLINE pRasterRef #-}
+   44 pRasterRef :: IORef Raster
+   45 pRasterRef = unsafePerformIO (newIORef RasterNone)
+   46 
+   47 {-# NOINLINE pRaster #-}
+   48 -- | Selected raster engine.
+   49 pRaster :: Raster
+   50 pRaster = unsafePerformIO (readIORef pRasterRef)
+   51 
+   52 -- | Set raster engine.
+   53 setRaster :: Raster -> IO ()
+   54 setRaster = writeIORef pRasterRef
+   55 
+   56 {-# NOINLINE pFPSRef #-}
+   57 pFPSRef :: IORef FPS
+   58 pFPSRef = unsafePerformIO (newIORef 0)
+   59 
+   60 {-# NOINLINE pFPS #-}
+   61 -- | Selected framerate.
+   62 pFPS :: FPS
+   63 pFPS = unsafePerformIO (readIORef pFPSRef)
+   64 
+   65 -- | Set desired framerate.
+   66 setFPS :: FPS -> IO ()
+   67 setFPS = writeIORef pFPSRef
+   68 
+   69 {-# NOINLINE pWidthRef #-}
+   70 pWidthRef :: IORef FPS
+   71 pWidthRef = unsafePerformIO (newIORef 0)
+   72 
+   73 {-# NOINLINE pWidth #-}
+   74 -- | Width of animation in pixel.
+   75 pWidth :: Width
+   76 pWidth = unsafePerformIO (readIORef pWidthRef)
+   77 
+   78 -- | Set desired width of animation in pixel.
+   79 setWidth :: Width -> IO ()
+   80 setWidth = writeIORef pWidthRef
+   81 
+   82 {-# NOINLINE pHeightRef #-}
+   83 pHeightRef :: IORef FPS
+   84 pHeightRef = unsafePerformIO (newIORef 0)
+   85 
+   86 {-# NOINLINE pHeight #-}
+   87 -- | Height of animation in pixel.
+   88 pHeight :: Height
+   89 pHeight = unsafePerformIO (readIORef pHeightRef)
+   90 
+   91 -- | Set desired height of animation in pixel.
+   92 setHeight :: Height -> IO ()
+   93 setHeight = writeIORef pHeightRef
+   94 
+   95 {-# NOINLINE pNoExternalsRef #-}
+   96 pNoExternalsRef :: IORef Bool
+   97 pNoExternalsRef = unsafePerformIO (newIORef False)
+   98 
+   99 {-# NOINLINE pNoExternals #-}
+  100 -- | This parameter determined whether or not external tools are allowed.
+  101 --   If this flag is True then tools such as 'Reanimate.LaTeX.latex' and
+  102 --   'Reanimate.Blender.blender' will not be invoked.
+  103 pNoExternals :: Bool
+  104 pNoExternals = unsafePerformIO (readIORef pNoExternalsRef)
+  105 
+  106 -- | Set whether external tools are allowed.
+  107 setNoExternals :: Bool -> IO ()
+  108 setNoExternals = writeIORef pNoExternalsRef
+  109 
+  110 {-# NOINLINE pRootDirectoryRef #-}
+  111 pRootDirectoryRef :: IORef FilePath
+  112 pRootDirectoryRef = unsafePerformIO (newIORef (error "root directory not set"))
+  113 
+  114 {-# NOINLINE pRootDirectory #-}
+  115 -- | Root directory of animation. Images and other data has to be placed
+  116 --   here if they are referenced in an SVG image.
+  117 pRootDirectory :: FilePath
+  118 pRootDirectory = unsafePerformIO (readIORef pRootDirectoryRef)
+  119 
+  120 -- | Set the root animation directory.
+  121 setRootDirectory :: FilePath -> IO ()
+  122 setRootDirectory = writeIORef pRootDirectoryRef
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.PolyShape.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.PolyShape.hs.html new file mode 100644 index 0000000..8eb0b0d --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.PolyShape.hs.html @@ -0,0 +1,483 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-|
+    2 Module      : Reanimate.PolyShape
+    3 Copyright   : Written by David Himmelstrup
+    4 License     : Unlicense
+    5 Maintainer  : lemmih@gmail.com
+    6 Stability   : experimental
+    7 Portability : POSIX
+    8 
+    9 A PolyShape is a closed set of curves.
+   10 
+   11 -}
+   12 module Reanimate.PolyShape
+   13   ( PolyShape(..)
+   14   , PolyShapeWithHoles
+   15   , svgToPolyShapes     -- :: Tree -> [PolyShape]
+   16   , svgToPolygons       -- :: Double -> Svg -> [Polygon]
+   17 
+   18   , renderPolyShape     -- :: PolyShape -> Tree
+   19   , renderPolyShapes    -- :: [PolyShape] -> Tree
+   20   , renderPolyShapePoints -- :: PolyShape -> Tree
+   21 
+   22   , plPathCommands      -- :: PolyShape -> [PathCommand]
+   23   , plLineCommands      -- :: PolyShape -> [LineCommand]
+   24 
+   25   , plLength            -- :: PolyShape -> Double
+   26   , plArea
+   27   , plCurves            -- :: PolyShape -> [CubicBezier Double]
+   28   , isInsideOf          -- :: PolyShape -> PolyShape -> Bool
+   29 
+   30   , plFromPolygon       -- :: [RPoint] -> PolyShape
+   31   , plToPolygon         -- :: Double -> PolyShape -> Polygon
+   32   , plDecompose         -- :: [PolyShape] -> [[RPoint]]
+   33   , unionPolyShapes     -- :: [PolyShape] -> [PolyShape]
+   34   , unionPolyShapes'    -- :: Double -> [PolyShape] -> [PolyShape]
+   35   , plDecompose'        -- :: Double -> [PolyShape] -> [[RPoint]]
+   36   , decomposePolygon    -- :: [Point Double] -> [[RPoint]]
+   37   , plGroupShapes       -- :: [PolyShape] -> [PolyShapeWithHoles]
+   38   , mergePolyShapeHoles -- :: PolyShapeWithHoles -> PolyShape
+   39   , plPartial
+   40   , plGroupTouching
+   41   ) where
+   42 
+   43 import           Algorithms.Geometry.PolygonTriangulation.Triangulate (triangulate')
+   44 import           Control.Lens ((&), (.~), (^.))
+   45 import           Data.Ext
+   46 import           Data.Geometry.PlanarSubdivision (PolygonFaceData (..))
+   47 import qualified Data.Geometry.Point as Geo
+   48 import qualified Data.Geometry.Polygon as Geo
+   49 import           Data.List (nub, partition, sortOn)
+   50 import qualified Data.PlaneGraph as Geo
+   51 import           Data.Proxy
+   52 import qualified Data.Vector as V
+   53 import           Geom2D.CubicBezier.Linear (ClosedPath (..), CubicBezier (..), FillRule (..),
+   54                                             PathJoin (..), QuadBezier (..), arcLength,
+   55                                             arcLengthParam, bezierIntersection, bezierSubsegment,
+   56                                             closedPathCurves, closest, colinear, curvesToClosed,
+   57                                             evalBezier, quadToCubic, reorient, splitBezier, union,
+   58                                             vectorDistance)
+   59 import           Graphics.SvgTree (PathCommand (..), RPoint, Tree (..), defaultSvg, pathDefinition)
+   60 import           Linear.V2
+   61 import           Reanimate.Animation
+   62 import           Reanimate.Constants
+   63 import           Reanimate.Math.Polygon (Polygon, mkPolygon, pArea, pIsCCW)
+   64 import           Reanimate.Svg
+   65 
+   66 -- | Shape drawn by continuous line. May have overlap, may be convex.
+   67 newtype PolyShape = PolyShape { unPolyShape :: ClosedPath Double }
+   68   deriving (Show)
+   69 
+   70 -- | Polyshape with smaller, fully-enclosed holes.
+   71 data PolyShapeWithHoles = PolyShapeWithHoles
+   72   { polyShapeParent :: PolyShape
+   73   , polyShapeHoles  :: [PolyShape]
+   74   }
+   75 
+   76 
+   77 -- | Render a set of polyshapes as a single SVG path.
+   78 renderPolyShapes :: [PolyShape] -> Tree
+   79 renderPolyShapes pls =
+   80   PathTree $ defaultSvg & pathDefinition .~ concatMap plPathCommands pls
+   81 
+   82 -- | Render a polyshape as a single SVG path.
+   83 renderPolyShape :: PolyShape -> Tree
+   84 renderPolyShape pl =
+   85     PathTree $ defaultSvg & pathDefinition .~ plPathCommands pl
+   86 
+   87 -- | Render control-points of a polyshape as circles.
+   88 renderPolyShapePoints :: PolyShape -> Tree
+   89 renderPolyShapePoints = mkGroup . map renderPoint . plCurves
+   90   where
+   91     renderPoint (CubicBezier (V2 x y) _ _ _) =
+   92       translate x y $ mkCircle 0.02
+   93 
+   94 -- | Length of polyshape circumference.
+   95 plLength :: PolyShape -> Double
+   96 plLength = sum . map cubicLength . plCurves
+   97   where
+   98     cubicLength c = arcLength c 1 polyShapeTolerance
+   99 
+  100 -- | Area of polyshape.
+  101 plArea :: PolyShape -> Double
+  102 plArea pl = realToFrac $ pArea $ plToPolygon polyShapeTolerance pl
+  103 
+  104 -- 1/10th of a pixel if rendered at 2560x1440
+  105 polyShapeTolerance :: Double
+  106 polyShapeTolerance = screenWidth/25600
+  107 
+  108 -- | Construct a polyshape from the vertices in a polygon.
+  109 plFromPolygon :: [RPoint] -> PolyShape
+  110 plFromPolygon = PolyShape . ClosedPath . map worker
+  111   where
+  112     worker val = (val, JoinLine)
+  113 
+  114 -- | Approximate a polyshape as a polygon within the given tolerance.
+  115 plToPolygon :: Double -> PolyShape -> Polygon
+  116 plToPolygon tol pl =
+  117   let p = V.init . V.fromList . map (fmap realToFrac) .
+  118           plPolygonify tol $ pl
+  119   in if pIsCCW (mkPolygon p) then mkPolygon p else mkPolygon (V.reverse p)
+  120 
+  121 -- | Partially draw polyshape.
+  122 plPartial :: Double -> PolyShape -> PolyShape
+  123 plPartial delta pl | delta >= 1 = pl
+  124 plPartial delta pl = PolyShape $ curvesToClosed (lineOut ++ [joinB] ++ lineIn)
+  125   where
+  126     lineOutEnd = cubicC3 (last lineOut)
+  127     lineInBegin = cubicC0 (head lineIn)
+  128     joinB = CubicBezier lineOutEnd lineOutEnd lineOutEnd lineInBegin
+  129     lineOut = takeLen (len*delta/2) $ plCurves pl
+  130     lineIn =
+  131       reverse $ map reorient $
+  132       takeLen (len*delta/2) $ reverse $ map reorient $ plCurves pl
+  133     len = plLength pl
+  134     takeLen _ [] = []
+  135     takeLen l (c:cs) =
+  136       let cLen = arcLength c 1 polyShapeTolerance in
+  137       if l < cLen
+  138         then [bezierSubsegment c 0 (arcLengthParam c l polyShapeTolerance)]
+  139         else c : takeLen (l-cLen) cs
+  140 
+  141 -- earClip :: Polygon -> Triangulation
+  142 -- dual :: Triangulation -> Dual
+  143 -- toPDual :: Polygon -> Dual -> PDual
+  144 -- pdualReduce :: Polygon -> PDual -> Int -> PDual
+  145 -- pdualPolygons :: Polygon -> PDual -> [Polygon]
+  146 -- splitPolyShape :: Double -> Int -> PolyShape -> [PolyShape]
+  147 -- splitPolyShape tol n poly =
+  148 --     let polygon = toPolygon (plPolygonify tol poly)
+  149 --         trig = triangulate $ pRing polygon
+  150 --         d = dual 0 trig
+  151 --         pd = toPDual (pRing polygon) d
+  152 --         reduced = pdualReduce (pRing polygon) pd n
+  153 --         polygons = pdualPolygons polygon reduced
+  154 --     in map toPolyShape polygons
+  155 --   where
+  156 --     toPolygon :: [RPoint] -> Polygon
+  157 --     toPolygon = mkPolygon . V.fromList . nub . map (fmap realToFrac)
+  158 --     toPolyShape :: Polygon -> PolyShape
+  159 --     toPolyShape = plFromPolygon . map (fmap realToFrac) . V.toList . polygonPoints
+  160 
+  161 -- plPartial' :: Double -> ([RPoint], PolyShape) -> PolyShape
+  162 -- plPartial' delta (seen', PolyShape (ClosedPath lst)) =
+  163 --   case lst of
+  164 --     []                         -> PolyShape (ClosedPath [])
+  165 --     (startP, startJoin) : rest -> PolyShape $ ClosedPath $
+  166 --       (startP, startJoin) : worker startP rest
+  167 --   where
+  168 --     seen = filter (`elem` plPoints) seen'
+  169 --     closestSeen pt = minimumBy (comparing (vectorDistance pt)) seen
+  170 --     worker _ [] = []
+  171 --     worker _ ((newP, newJoin) : rest)
+  172 --       | newP `elem` seen = (newP, newJoin) : worker newP rest
+  173 --       | otherwise =
+  174 --         let newAt = interpolateVector (closestSeen newP) newP delta
+  175 --         in (newAt, newJoin) : worker newAt rest
+  176 --     plPoints =
+  177 --       [ p | (p,_) <- lst ]
+  178 
+  179 -- | Find intersection points.
+  180 plGroupTouching :: [PolyShape] -> [[([RPoint],PolyShape)]]
+  181 plGroupTouching [] = []
+  182 plGroupTouching pls = worker [polyShapeOrigin (head pls)] pls
+  183   where
+  184     worker _ [] = []
+  185     worker seen shapes =
+  186       let (touching, notTouching) = partition (isTouching seen) shapes
+  187       in if null touching
+  188         then plGroupTouching notTouching
+  189         else map ((,) seen . changeOrigin seen) touching   :
+  190              worker (seen ++ concatMap plPoints touching) notTouching
+  191     isTouching pts = any (`elem` pts) . plPoints
+  192     changeOrigin seen (PolyShape (ClosedPath segments)) = PolyShape $ ClosedPath $ helper [] segments
+  193       where
+  194         helper acc [] = reverse acc
+  195         helper acc lst@((startP,startJ):rest)
+  196           | startP `elem` seen = lst ++ reverse acc
+  197           | otherwise = helper ((startP, startJ):acc) rest
+  198     plPoints :: PolyShape -> [RPoint]
+  199     plPoints (PolyShape (ClosedPath lst)) =
+  200       [ p | (p,_) <- lst ]
+  201 
+  202 -- | Deconstruct a polyshape into non-intersecting, convex polygons.
+  203 plDecompose :: [PolyShape] -> [[RPoint]]
+  204 plDecompose = plDecompose' 0.001
+  205 
+  206 -- | Deconstruct a polyshape into non-intersecting, convex polygons.
+  207 plDecompose' :: Double -> [PolyShape] -> [[RPoint]]
+  208 plDecompose' tol =
+  209   concatMap (decomposePolygon . plPolygonify tol . mergePolyShapeHoles) .
+  210   plGroupShapes .
+  211   unionPolyShapes
+  212 
+  213 -- | Split polygon into smaller, convex polygons.
+  214 decomposePolygon :: [RPoint] -> [[RPoint]]
+  215 decomposePolygon poly =
+  216   [ [ V2 x y
+  217     | v <- V.toList (Geo.boundaryVertices f pg)
+  218     , let Geo.Point2 x y =(pg^.Geo.vertexDataOf v) ^. Geo.location ]
+  219   | (f, Inside) <- V.toList (Geo.internalFaces pg) ]
+  220 
+  221   where
+  222     pg = triangulate' Proxy p
+  223     p = Geo.fromPoints $
+  224       [ Geo.Point2 x y :+ ()
+  225       | V2 x y <- poly ]
+  226 
+  227 plPolygonify :: Double -> PolyShape -> [RPoint]
+  228 plPolygonify tol shape =
+  229     startPoint (head curves) : concatMap worker curves
+  230   where
+  231     curves = plCurves shape
+  232     worker c | endPoint c == startPoint c =
+  233       [] -- error $ "Bad bezier: " ++ show c
+  234     worker c =
+  235       if colinear c tol -- && arcLength c 1 tol < 1
+  236         then [endPoint c]
+  237         else
+  238           let (lhs,rhs) = splitBezier c 0.5
+  239           in worker lhs ++ worker rhs
+  240     endPoint (CubicBezier _ _ _ d) = d
+  241     startPoint (CubicBezier a _ _ _) = a
+  242 
+  243 -- | Convert a polyshape to a list of SVG path commands.
+  244 plPathCommands :: PolyShape -> [PathCommand]
+  245 plPathCommands = lineToPath . plLineCommands
+  246 
+  247 -- | Convert a polyshape to a list of line commands.
+  248 plLineCommands :: PolyShape -> [LineCommand]
+  249 plLineCommands pl =
+  250   case curves of
+  251     []                  -> []
+  252     (CubicBezier start _ _ _:_) ->
+  253       LineMove start :
+  254       zipWith worker (drop 1 dstList ++ [start]) joinList ++
+  255       [LineEnd start]
+  256   where
+  257     ClosedPath closedPath = unPolyShape pl
+  258     (dstList, joinList) = unzip closedPath
+  259     curves = plCurves pl
+  260     worker dst JoinLine =
+  261       LineBezier [dst]
+  262     worker dst (JoinCurve a b) =
+  263       LineBezier [a,b,dst]
+  264 
+  265 -- | Extract all shapes from SVG nodes. Drawing attributes such
+  266 --   as stroke and fill color are discarded.
+  267 svgToPolyShapes :: Tree -> [PolyShape]
+  268 svgToPolyShapes = cmdsToPolyShapes . toLineCommands . extractPath
+  269 
+  270 -- | Extract all polygons from SVG nodes. Curves are approximated to
+  271 --   within the given tolerance.
+  272 svgToPolygons :: Double -> SVG -> [Polygon]
+  273 svgToPolygons tol = map (toPolygon . plPolygonify tol) . svgToPolyShapes
+  274   where
+  275     toPolygon :: [RPoint] -> Polygon
+  276     toPolygon = mkPolygon .
+  277       V.fromList . nub . map (fmap realToFrac)
+  278 
+  279 cmdsToPolyShapes :: [LineCommand] -> [PolyShape]
+  280 cmdsToPolyShapes [] = []
+  281 cmdsToPolyShapes cmds =
+  282     case cmds of
+  283       (LineMove dst:cont) -> map PolyShape $ worker dst [] cont
+  284       _                   -> bad
+  285   where
+  286     bad = error $ "Reanimate.PolyShape: Invalid commands: " ++ show cmds
+  287     finalize [] rest  = rest
+  288     finalize acc rest = ClosedPath (reverse acc) : rest
+  289     worker _from acc [] = finalize acc []
+  290     worker _from acc (LineMove newStart : xs) =
+  291       finalize acc $
+  292       worker newStart [] xs
+  293     worker from acc (LineEnd orig:LineMove dst:xs) | from /= orig =
+  294       finalize ((from, JoinLine):acc) $
+  295       worker dst [] xs
+  296     worker _from acc (LineEnd{}:LineMove dst:xs) =
+  297       finalize acc $
+  298       worker dst [] xs
+  299     worker from acc [LineEnd orig] | from /= orig =
+  300       finalize ((from, JoinLine):acc) []
+  301     worker _from acc [LineEnd{}] =
+  302       finalize acc []
+  303     worker from acc (LineBezier [x]:xs) =
+  304       worker x ((from, JoinLine) : acc) xs
+  305     worker from acc (LineBezier [a,b]:xs) =
+  306       let quad = QuadBezier from a b
+  307           CubicBezier _ a' b' c' = quadToCubic quad
+  308       in worker from acc (LineBezier [a',b',c']:xs)
+  309     worker from acc (LineBezier [a,b,c]:xs) =
+  310       worker c ((from, JoinCurve a b) : acc) xs
+  311     worker _ _ _ = bad
+  312 
+  313 -- | Merge overlapping shapes.
+  314 unionPolyShapes :: [PolyShape] -> [PolyShape]
+  315 unionPolyShapes shapes =
+  316     map PolyShape $
+  317     union (map unPolyShape shapes) FillNonZero (polyShapeTolerance/10000)
+  318 
+  319 -- | Merge overlapping shapes to within given tolerance.
+  320 unionPolyShapes' :: Double -> [PolyShape] -> [PolyShape]
+  321 unionPolyShapes' tol shapes =
+  322     map PolyShape $
+  323     union (map unPolyShape shapes) FillNonZero tol
+  324 
+  325 -- | True iff lhs is inside of rhs.
+  326 --   lhs and rhs may not overlap.
+  327 --   Implementation: Trace a vertical line through the origin of A and check
+  328 --   of this line intersects and odd number of times on both sides of A.
+  329 isInsideOf :: PolyShape -> PolyShape -> Bool
+  330 lhs `isInsideOf` rhs =
+  331     odd (length upHits) && odd (length downHits)
+  332   where
+  333     (upHits, downHits) = polyIntersections origin rhs
+  334     origin = polyShapeOrigin lhs
+  335 
+  336 polyIntersections :: RPoint -> PolyShape -> ([RPoint],[RPoint])
+  337 polyIntersections origin rhs =
+  338     (nub $ concatMap (intersections rayUp) curves
+  339     ,nub $ concatMap (intersections rayDown) curves)
+  340   where
+  341     curves = plCurves rhs
+  342 
+  343     intersections line bs =
+  344       map (evalBezier bs . fst) (bezierIntersection bs line polyShapeTolerance)
+  345     limit = 1000
+  346     rayUp = CubicBezier origin origin origin (V2 limit limit)
+  347     rayDown = CubicBezier origin origin origin (V2 (-limit) (-limit))
+  348 
+  349 polyShapeOrigin :: PolyShape -> V2 Double
+  350 polyShapeOrigin (PolyShape closedPath) =
+  351   case closedPath of
+  352     ClosedPath []            -> V2 0 0
+  353     ClosedPath ((start,_):_) -> start
+  354 
+  355 -- | Find holes and group them with their parent.
+  356 plGroupShapes :: [PolyShape] -> [PolyShapeWithHoles]
+  357 plGroupShapes = worker
+  358   where
+  359     worker (s:rest)
+  360       | null (parents s rest) =
+  361         let isOnlyChild x = parents x (s:rest) == [s]
+  362             (holes, nonHoles) = partition isOnlyChild rest
+  363             prime = PolyShapeWithHoles
+  364               { polyShapeParent = s
+  365               , polyShapeHoles  = holes }
+  366         in prime : worker nonHoles
+  367       | otherwise = worker (rest ++ [s])
+  368     worker [] = []
+  369 
+  370     parents :: PolyShape -> [PolyShape] -> [PolyShape]
+  371     parents self = filter (self `isInsideOf`) . filter (/=self)
+  372 
+  373 instance Eq PolyShape where
+  374   a == b = plCurves a == plCurves b
+  375 
+  376 -- | Cut out holes.
+  377 mergePolyShapeHoles :: PolyShapeWithHoles -> PolyShape
+  378 mergePolyShapeHoles (PolyShapeWithHoles parent []) = parent
+  379 mergePolyShapeHoles (PolyShapeWithHoles parent (child:children)) =
+  380   mergePolyShapeHoles $
+  381     PolyShapeWithHoles (mergePolyShapeHole parent child) children
+  382 
+  383 -- Merge
+  384 mergePolyShapeHole :: PolyShape -> PolyShape -> PolyShape
+  385 mergePolyShapeHole parent child =
+  386   snd $ head $
+  387   sortOn fst
+  388   [ cutSingleHole newParent child
+  389   | newParent <- polyShapePermutations parent ]
+  390 
+  391 {-
+  392 parent:
+  393   (a,b)
+  394   (b,c)
+  395   (c,a)
+  396 
+  397 child:
+  398   (x,y)
+  399   (y,z)
+  400   (z,x)
+  401 
+  402 P = split (a,b)
+  403 new:
+  404   (P,b) p2b
+  405   (b,c) pTail
+  406   (c,a) pTail
+  407   (a,P) a2p
+  408 
+  409   (P,x) p2x
+  410 
+  411   (x,y) childCurves
+  412   (y,z) childCurves
+  413   (z,x) childCurves
+  414 
+  415   (x,P) x2p
+  416 
+  417 -}
+  418 cutSingleHole :: PolyShape -> PolyShape -> (Double, PolyShape)
+  419 cutSingleHole parent child =
+  420     (score, PolyShape $ curvesToClosed $
+  421       p2b:pTail ++ [a2p] ++
+  422       [p2x] ++ childCurves ++
+  423       [x2p]
+  424     )
+  425   where
+  426     -- vect = (childOrigin - p) * 0 -- 0.0001
+  427     vectL = 0 -- rotate90L $* vect
+  428     vectR = 0 -- rotate90R $* vect
+  429     score = vectorDistance childOrigin p
+  430     childOrigin = polyShapeOrigin child
+  431     childOrigin' = childOrigin - vectL
+  432     (pHead:pTail) = plCurves parent
+  433     childCurves = plCurves child
+  434 
+  435     pParam = closest pHead childOrigin polyShapeTolerance
+  436 
+  437     (a2p, p2b') = splitBezier pHead pParam
+  438     p2b = case p2b' of
+  439       CubicBezier a b c d -> CubicBezier (a - vectL) b c d
+  440 
+  441     p = evalBezier pHead pParam
+  442     -- straight line to child origin
+  443     p2x = lineBetween (p - vectR) childOrigin
+  444     -- straight line from child origin
+  445     x2p = lineBetween childOrigin' p
+  446 
+  447     lineBetween a = CubicBezier a a a
+  448 
+  449 -- | Destruct a polyshape into constituent curves.
+  450 plCurves :: PolyShape -> [CubicBezier Double]
+  451 plCurves = closedPathCurves . unPolyShape
+  452 
+  453 polyShapePermutations :: PolyShape -> [PolyShape]
+  454 polyShapePermutations =
+  455     map (PolyShape . curvesToClosed) . cycleList . plCurves
+  456   where
+  457     cycleList lst =
+  458       let n = length lst in
+  459       [ take n $ drop i $ cycle lst
+  460       | i <- [0.. n-1] ]
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Raster.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Raster.hs.html new file mode 100644 index 0000000..de5128f --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Raster.hs.html @@ -0,0 +1,338 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-|
+    2 Module      : Reanimate.Raster
+    3 Copyright   : Written by David Himmelstrup
+    4 License     : Unlicense
+    5 Maintainer  : lemmih@gmail.com
+    6 Stability   : experimental
+    7 Portability : POSIX
+    8 
+    9 Tools for generating, manipulating, and embedding raster images.
+   10 
+   11 -}
+   12 module Reanimate.Raster
+   13   ( mkImage           -- :: Double -> Double -> FilePath -> SVG
+   14   , cacheImage        -- :: (PngSavable pixel, Hashable a) => a -> Image pixel -> FilePath
+   15   , prerenderSvg      -- :: Hashable a => a -> SVG -> SVG
+   16   , prerenderSvgFile  -- :: Hashable a => a -> Width -> Height -> SVG -> FilePath
+   17   , embedImage        -- :: PngSavable a => Image a -> SVG
+   18   , embedDynamicImage -- :: DynamicImage -> SVG
+   19   , embedPng          -- :: Double -> Double -> LBS.ByteString -> SVG
+   20   , raster            -- :: SVG -> DynamicImage
+   21   , rasterSized       -- :: Width -> Height -> SVG -> DynamicImage
+   22   , vectorize         -- :: FilePath -> SVG
+   23   , vectorize_        -- :: [String] -> FilePath -> SVG
+   24   , svgAsPngFile      -- :: SVG -> FilePath
+   25   , svgAsPngFile'     -- :: Width -> Height -> SVG -> FilePath
+   26   )
+   27 where
+   28 
+   29 import           Codec.Picture
+   30 import           Control.Lens                             ( (&)
+   31                                                           , (.~)
+   32                                                           )
+   33 import           Control.Monad
+   34 import qualified Data.ByteString               as B
+   35 import qualified Data.ByteString.Base64.Lazy   as Base64
+   36 import qualified Data.ByteString.Lazy.Char8    as LBS
+   37 import           Data.Hashable
+   38 import qualified Data.Text                     as T
+   39 import           Graphics.SvgTree                         ( Number(..)
+   40                                                           , Tree(..)
+   41                                                           , defaultSvg
+   42                                                           , parseSvgFile
+   43                                                           )
+   44 import qualified Graphics.SvgTree              as Svg
+   45 import           Reanimate.Animation
+   46 import           Reanimate.Cache
+   47 import           Reanimate.Driver.Magick
+   48 import           Reanimate.Misc
+   49 import           Reanimate.Render
+   50 import           Reanimate.Parameters
+   51 import           Reanimate.Constants
+   52 import           Reanimate.Svg.Constructors
+   53 import           Reanimate.Svg.Unuse
+   54 import           System.Directory
+   55 import           System.FilePath
+   56 import           System.IO
+   57 import           System.IO.Temp
+   58 import           System.IO.Unsafe
+   59 
+   60 -- | Load an external image. Width and height must be specified,
+   61 --   ignoring the image's aspect ratio. The center of the image is
+   62 --   placed at position (0,0).
+   63 --
+   64 --   For security reasons, must SVG renderer do not allow arbitrary
+   65 --   image links. For some renderers, we can get around this by placing
+   66 --   the images in the same root directory as the parent SVG file. Other
+   67 --   renderers (like Chrome and ffmpeg) requires that the image is inlined
+   68 --   as base64 data. External SVG files are an exception, though, as must
+   69 --   always be inlined directly. `mkImage` attempts to hide all the complexity
+   70 --   but edge-cases may exist.
+   71 --
+   72 --   Example:
+   73 --
+   74 --   > mkImage screenWidth screenHeight "../data/haskell.svg"
+   75 --
+   76 --   <<docs/gifs/doc_mkImage.gif>>
+   77 mkImage
+   78   :: Double -- ^ Desired image width.
+   79   -> Double -- ^ Desired image height.
+   80   -> FilePath -- ^ Path to external image file.
+   81   -> SVG
+   82 mkImage width height path | takeExtension path == ".svg" = unsafePerformIO $ do
+   83   svg_data <- B.readFile path
+   84   case parseSvgFile path svg_data of
+   85     Nothing -> error "Malformed svg"
+   86     Just svg ->
+   87       return
+   88         $ scaleXY (width / screenWidth) (height / screenHeight)
+   89         $ embedDocument svg
+   90 mkImage width height path | pRaster == RasterNone = unsafePerformIO $ do
+   91   inp <- LBS.readFile path
+   92   let imgData = LBS.unpack $ Base64.encode inp
+   93   return
+   94     $  flipYAxis
+   95     $  ImageTree
+   96     $  defaultSvg
+   97     &  Svg.imageWidth
+   98     .~ Svg.Num width
+   99     &  Svg.imageHeight
+  100     .~ Svg.Num height
+  101     &  Svg.imageHref
+  102     .~ ("data:" ++ mimeType ++ ";base64," ++ imgData)
+  103     &  Svg.imageCornerUpperLeft
+  104     .~ (Svg.Num (-width / 2), Svg.Num (-height / 2))
+  105     &  Svg.imageAspectRatio
+  106     .~ Svg.PreserveAspectRatio False Svg.AlignNone Nothing
+  107  where
+  108     -- FIXME: Is there a better way to do this?
+  109   mimeType = case takeExtension path of
+  110     ".jpg" -> "image/jpeg"
+  111     ext    -> "image/" ++ drop 1 ext
+  112 mkImage width height path = unsafePerformIO $ do
+  113   exists <- doesFileExist target
+  114   unless exists $ copyFile path target
+  115   return
+  116     $  flipYAxis
+  117     $  ImageTree
+  118     $  defaultSvg
+  119     &  Svg.imageWidth
+  120     .~ Svg.Num width
+  121     &  Svg.imageHeight
+  122     .~ Svg.Num height
+  123     &  Svg.imageHref
+  124     .~ ("file://" ++ target)
+  125     &  Svg.imageCornerUpperLeft
+  126     .~ (Svg.Num (-width / 2), Svg.Num (-height / 2))
+  127     &  Svg.imageAspectRatio
+  128     .~ Svg.PreserveAspectRatio False Svg.AlignNone Nothing
+  129  where
+  130   target   = pRootDirectory </> encodeInt hashPath <.> takeExtension path
+  131   hashPath = hash path
+  132 
+  133 -- | Write in-memory image to cache file if (and only if) such cache file doesn't
+  134 --   already exist.
+  135 cacheImage :: (PngSavable pixel, Hashable a) => a -> Image pixel -> FilePath
+  136 cacheImage key gen = unsafePerformIO $ cacheFile template $ \path ->
+  137   writePng path gen
+  138   where template = encodeInt (hash key) <.> "png"
+  139 
+  140 -- Warning: Caching svg elements with links to external objects does
+  141 --          not work. 2020-06-01
+  142 -- | Same as 'prerenderSvg' but returns the location of the rendered image
+  143 --   as a FilePath.
+  144 prerenderSvgFile :: Hashable a => a -> Width -> Height -> SVG -> FilePath
+  145 prerenderSvgFile key width height svg =
+  146   unsafePerformIO $ cacheFile template $ \path -> do
+  147     let svgPath = replaceExtension path "svg"
+  148     writeFile svgPath rendered
+  149     engine <- requireRaster pRaster
+  150     applyRaster engine svgPath
+  151  where
+  152   template = encodeInt (hash (key, width, height)) <.> "png"
+  153   rendered = renderSvg (Just $ Px $ fromIntegral width)
+  154                        (Just $ Px $ fromIntegral height)
+  155                        svg
+  156 
+  157 -- | Render SVG node to a PNG file and return a new node containing
+  158 --   that image. For static SVG nodes, this can hugely improve performance.
+  159 --   The first argument is the key that determines SVG uniqueness. It
+  160 --   is entirely your responsibility to ensure that all keys are unique.
+  161 --   If they are not, you will be served stale results from the cache.
+  162 prerenderSvg :: Hashable a => a -> SVG -> SVG
+  163 prerenderSvg key =
+  164   mkImage screenWidth screenHeight . prerenderSvgFile key pWidth pHeight
+  165 
+  166 
+  167 {-# INLINE embedImage #-}
+  168 -- | Embed an in-memory PNG image. Note, the pixel size of the image
+  169 --   is used as the dimensions. As such, embedding a 100x100 PNG will
+  170 --   result in an image 100 units wide and 100 units high. Consider
+  171 --   using with 'scaleToSize'.
+  172 embedImage :: PngSavable a => Image a -> SVG
+  173 embedImage img = embedPng width height (encodePng img)
+  174  where
+  175   width  = fromIntegral $ imageWidth img
+  176   height = fromIntegral $ imageHeight img
+  177 
+  178 -- | Embed in-memory PNG bytestring without parsing it.
+  179 embedPng
+  180   :: Double -- ^ Width
+  181   -> Double -- ^ Height
+  182   -> LBS.ByteString -- ^ Raw PNG data
+  183   -> SVG
+  184 -- embedPng w h png = unsafePerformIO $ do
+  185 --     LBS.writeFile path png
+  186 --     return $ ImageTree $ defaultSvg
+  187 --       & Svg.imageCornerUpperLeft .~ (Svg.Num (-w/2), Svg.Num (-h/2))
+  188 --       & Svg.imageWidth .~ Svg.Num w
+  189 --       & Svg.imageHeight .~ Svg.Num h
+  190 --       & Svg.imageHref .~ ("file://"++path)
+  191 --   where
+  192 --     path = "/tmp" </> show (hash png) <.> "png"
+  193 embedPng w h png =
+  194   flipYAxis
+  195     $  ImageTree
+  196     $  defaultSvg
+  197     &  Svg.imageCornerUpperLeft
+  198     .~ (Svg.Num (-w / 2), Svg.Num (-h / 2))
+  199     &  Svg.imageWidth
+  200     .~ Svg.Num w
+  201     &  Svg.imageHeight
+  202     .~ Svg.Num h
+  203     &  Svg.imageHref
+  204     .~ ("data:image/png;base64," ++ imgData)
+  205   where imgData = LBS.unpack $ Base64.encode png
+  206 
+  207 
+  208 {-# INLINE embedDynamicImage #-}
+  209 -- | Embed an in-memory image. Note, the pixel size of the image
+  210 --   is used as the dimensions. As such, embedding a 100x100 image will
+  211 --   result in an image 100 units wide and 100 units high. Consider
+  212 --   using with 'scaleToSize'.
+  213 embedDynamicImage :: DynamicImage -> SVG
+  214 embedDynamicImage img = embedPng width height imgData
+  215  where
+  216   width   = fromIntegral $ dynamicMap imageWidth img
+  217   height  = fromIntegral $ dynamicMap imageHeight img
+  218   imgData = case encodeDynamicPng img of
+  219     Left  err -> error err
+  220     Right dat -> dat
+  221 
+  222 -- embedImageFile :: FilePath -> Tree
+  223 -- embedImageFile path = unsafePerformIO $ do
+  224 --     png <- B.readFile path
+  225 --     case decodePng png of
+  226 --       Left{}    -> error "bad image"
+  227 --       Right img -> return $
+  228 --         let width   = fromIntegral $ dynamicMap imageWidth img
+  229 --             height  = fromIntegral $ dynamicMap imageHeight img in
+  230 --         ImageTree $ defaultSvg
+  231 --           & Svg.imageCornerUpperLeft .~ (Svg.Num (-width/2), Svg.Num (-height/2))
+  232 --           & Svg.imageWidth .~ Svg.Num width
+  233 --           & Svg.imageHeight .~ Svg.Num height
+  234 --           & Svg.imageHref .~ ("file://" ++ path)
+  235 
+  236 
+  237 -- | Convert an SVG object to a pixel-based image. The default resolution
+  238 --   is 2560x1440. See also 'rasterSized'. Multiple raster engines are supported
+  239 --   and are selected using the '--raster' flag in the driver.
+  240 raster :: SVG -> DynamicImage
+  241 raster = rasterSized 2560 1440
+  242 
+  243 -- | Convert an SVG object to a pixel-based image.
+  244 rasterSized
+  245   :: Width  -- ^ X resolution in pixels
+  246   -> Height -- ^ Y resolution in pixels
+  247   -> SVG    -- ^ SVG object
+  248   -> DynamicImage
+  249 rasterSized w h svg = unsafePerformIO $ do
+  250   png <- B.readFile (svgAsPngFile' w h svg)
+  251   case decodePng png of
+  252     Left{}    -> error "bad image"
+  253     Right img -> return img
+  254 
+  255 -- | Use \'potrace\' to trace edges in a raster image and convert them to SVG polygons.
+  256 vectorize :: FilePath -> SVG
+  257 vectorize = vectorize_ []
+  258 
+  259 -- | Same as 'vectorize' but takes a list of arguments for \'potrace\'.
+  260 vectorize_ :: [String] -> FilePath -> SVG
+  261 vectorize_ _ path | pNoExternals = mkText $ T.pack path
+  262 vectorize_ args path             = unsafePerformIO $ do
+  263   root <- getXdgDirectory XdgCache "reanimate"
+  264   createDirectoryIfMissing True root
+  265   let svgPath = root </> encodeInt key <.> "svg"
+  266   hit <- doesFileExist svgPath
+  267   unless hit $ withSystemTempFile "file.svg" $ \tmpSvgPath svgH ->
+  268     withSystemTempFile "file.bmp" $ \tmpBmpPath bmpH -> do
+  269       hClose svgH
+  270       hClose bmpH
+  271       potrace <- requireExecutable "potrace"
+  272       magick <- requireExecutable magickCmd
+  273       runCmd magick [path, "-flatten", tmpBmpPath]
+  274       runCmd potrace (args ++ ["--svg", "--output", tmpSvgPath, tmpBmpPath])
+  275       renameOrCopyFile tmpSvgPath svgPath
+  276   svg_data <- B.readFile svgPath
+  277   case parseSvgFile svgPath svg_data of
+  278     Nothing -> do
+  279       removeFile svgPath
+  280       error "Malformed svg"
+  281     Just svg -> return $ unbox $ replaceUses svg
+  282   where key = hash (path, args)
+  283 
+  284 -- imageAsFile :: DynamicImage -> FilePath
+  285 -- imageAsFile img
+  286 
+  287 -- | Convert an SVG object to a pixel-based image and save it to disk, returning
+  288 --   the filepath. The default resolution is 2560x1440. See also 'svgAsPngFile''.
+  289 --   Multiple raster engines are supported and are selected using the '--raster'
+  290 --   flag in the driver.
+  291 svgAsPngFile :: SVG -> FilePath
+  292 svgAsPngFile = svgAsPngFile' width height
+  293  where
+  294   width  = 2560
+  295   height = width * 9 `div` 16
+  296 
+  297 -- | Convert an SVG object to a pixel-based image and save it to disk, returning
+  298 --   the filepath.
+  299 svgAsPngFile'
+  300   :: Width  -- ^ Width
+  301   -> Height -- ^ Height
+  302   -> SVG    -- ^ SVG object
+  303   -> FilePath
+  304 svgAsPngFile' _ _ _ | pNoExternals = "/svgAsPngFile/has/been/disabled"
+  305 svgAsPngFile' width height svg =
+  306   unsafePerformIO $ cacheFile template $ \pngPath -> do
+  307     let svgPath = replaceExtension pngPath "svg"
+  308     writeFile svgPath rendered
+  309     engine <- requireRaster pRaster
+  310     applyRaster engine svgPath
+  311  where
+  312   template = encodeInt (hash rendered) <.> "png"
+  313   rendered = renderSvg (Just $ Px $ fromIntegral width)
+  314                        (Just $ Px $ fromIntegral height)
+  315                        svg
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Render.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Render.hs.html new file mode 100644 index 0000000..cc4c724 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Render.hs.html @@ -0,0 +1,437 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE MultiWayIf #-}
+    2 {-|
+    3 Copyright   : Written by David Himmelstrup
+    4 License     : Unlicense
+    5 Maintainer  : lemmih@gmail.com
+    6 Stability   : experimental
+    7 Portability : POSIX
+    8 
+    9 Internal tools for rastering SVGs and rendering videos. You are unlikely
+   10 to ever directly use the functions in this module.
+   11 
+   12 -}
+   13 module Reanimate.Render
+   14   ( render
+   15   , renderSvgs
+   16   , renderSnippets        -- :: Animation -> IO ()
+   17   , renderOneFrame
+   18   , Format(..)
+   19   , Raster(..)
+   20   , Width, Height, FPS
+   21   , requireRaster         -- :: Raster -> IO Raster
+   22   , selectRaster          -- :: Raster -> IO Raster
+   23   , applyRaster           -- :: Raster -> FilePath -> IO ()
+   24   ) where
+   25 
+   26 import           Control.Concurrent
+   27 import           Control.Exception
+   28 import           Control.Monad             (forM_, forever, unless, void, when)
+   29 import           Data.Either
+   30 import           Data.Function
+   31 import qualified Data.Text                 as T
+   32 import qualified Data.Text.IO              as T
+   33 import           Data.Time
+   34 import           Graphics.SvgTree          (Number (..))
+   35 import           Numeric
+   36 import           Reanimate.Animation
+   37 import           Reanimate.Driver.Check
+   38 import           Reanimate.Driver.Magick
+   39 import           Reanimate.Misc
+   40 import           Reanimate.Parameters
+   41 import           System.Console.ANSI.Codes
+   42 import           System.Exit
+   43 import           System.FileLock (withTryFileLock, SharedExclusive(..), unlockFile)
+   44 import           System.Directory
+   45 import           System.FilePath           (replaceExtension, (<.>), (</>))
+   46 import           System.IO
+   47 import           Text.Printf               (printf)
+   48 
+   49 idempotentFile :: FilePath -> IO () -> IO ()
+   50 idempotentFile path action = do
+   51     _ <- withTryFileLock lockFile Exclusive $ \lock -> do
+   52       haveFile <- doesFileExist path
+   53       unless haveFile action
+   54       unlockFile lock
+   55       _ <- try (removeFile lockFile) :: IO (Either SomeException ())
+   56       return ()
+   57     return ()
+   58   where
+   59     lockFile = path <.> "lock"
+   60 
+   61 -- | Generate SVGs at 60fps and put them in a folder.
+   62 renderSvgs :: FilePath -> Int -> Bool -> Animation -> IO ()
+   63 renderSvgs folder offset _prettyPrint ani = do
+   64   print frameCount
+   65   lock <- newMVar ()
+   66 
+   67   handle errHandler $ concurrentForM_ (frameOrder rate frameCount) $ \nth' -> do
+   68     let nth = (nth'+offset) `mod` frameCount
+   69         now = (duration ani / (fromIntegral frameCount - 1)) * fromIntegral nth
+   70         frame = frameAt (if frameCount <= 1 then 0 else now) ani
+   71         svg = renderSvg Nothing Nothing frame
+   72         path = folder </> show nth <.> "svg"
+   73 
+   74     idempotentFile path $ writeFile path svg
+   75     withMVar lock $ \_ -> do
+   76       print nth
+   77       hFlush stdout
+   78  where
+   79   rate       = 60
+   80   frameCount = round (duration ani * fromIntegral rate) :: Int
+   81   errHandler (ErrorCall msg) = do
+   82     hPutStrLn stderr msg
+   83     exitWith (ExitFailure 1)
+   84 
+   85 -- | Select a single frame that doesn't already exist in the output
+   86 --   folder and render it. If all frames have been rendered, print "Done".
+   87 renderOneFrame :: FilePath -> Int -> Bool -> Int -> Animation -> IO ()
+   88 renderOneFrame folder offset _prettyPrint rate ani =
+   89     worker (frameOrder rate frameCount)
+   90   where
+   91     worker [] = putStrLn "Done"
+   92     worker (x:xs) = do
+   93       let nth = (x+offset) `mod` frameCount
+   94           now = (duration ani / (fromIntegral frameCount - 1)) * fromIntegral nth
+   95           frame = frameAt (if frameCount <= 1 then 0 else now) ani
+   96           svg = renderSvg Nothing Nothing frame
+   97           path = folder </> show nth <.> "svg"
+   98           tmpPath = path <.> "tmp"
+   99       haveFile <- doesFileExist path
+  100       if haveFile
+  101         then worker xs
+  102         else do
+  103           writeFile tmpPath svg
+  104           renameOrCopyFile tmpPath path
+  105           print nth
+  106     frameCount = round (duration ani * fromIntegral rate) :: Int
+  107 
+  108 -- XXX: Merge with 'renderSvgs'
+  109 -- | Render 10 frames and print them to stdout. Used for testing.
+  110 --
+  111 --   XXX: Not related to the snippets in the playground.
+  112 renderSnippets :: Animation -> IO ()
+  113 renderSnippets ani = forM_ [0 .. frameCount - 1] $ \nth -> do
+  114   let now   = (duration ani / (fromIntegral frameCount - 1)) * fromIntegral nth
+  115       frame = frameAt now ani
+  116       svg   = renderSvg Nothing Nothing frame
+  117   putStr (show nth)
+  118   T.putStrLn $ T.concat . T.lines . T.pack $ svg
+  119   where frameCount = 10 :: Integer
+  120 
+  121 frameOrder :: Int -> Int -> [Int]
+  122 frameOrder fps nFrames = worker [] fps
+  123  where
+  124   worker _seen 0        = []
+  125   worker seen  nthFrame = filterFrameList seen nthFrame nFrames
+  126     ++ worker (nthFrame : seen) (nthFrame `div` 2)
+  127 
+  128 filterFrameList :: [Int] -> Int -> Int -> [Int]
+  129 filterFrameList seen nthFrame nFrames = filter (not . isSeen)
+  130                                                [0, nthFrame .. nFrames - 1]
+  131   where isSeen x = any (\y -> x `mod` y == 0) seen
+  132 
+  133 -- | Video formats supported by reanimate.
+  134 data Format = RenderMp4 | RenderGif | RenderWebm
+  135   deriving (Show)
+  136 
+  137 mp4Arguments :: FPS -> FilePath -> FilePath -> FilePath -> [String]
+  138 mp4Arguments fps progress template target =
+  139   [ "-r"
+  140   , show fps
+  141   , "-i"
+  142   , template
+  143   , "-y"
+  144   , "-c:v"
+  145   , "libx264"
+  146   , "-vf"
+  147   , "fps=" ++ show fps
+  148   , "-preset"
+  149   , "slow"
+  150   , "-crf"
+  151   , "18"
+  152   , "-movflags"
+  153   , "+faststart"
+  154   , "-progress"
+  155   , progress
+  156   , "-pix_fmt"
+  157   , "yuv420p"
+  158   , target
+  159   ]
+  160 
+  161 -- gifArguments :: FPS -> FilePath -> FilePath -> FilePath -> [String]
+  162 -- gifArguments fps progress template target =
+  163 
+  164 -- | Render animation to a video file with given parameters.
+  165 render
+  166   :: Animation
+  167   -> FilePath
+  168   -> Raster
+  169   -> Format
+  170   -> Width
+  171   -> Height
+  172   -> FPS
+  173   -> Bool
+  174   -> IO ()
+  175 render ani target raster format width height fps partial = do
+  176   printf "Starting render of animation: %.1f\n" (duration ani)
+  177   ffmpeg <- requireExecutable "ffmpeg"
+  178   generateFrames raster ani width height fps partial $ \template ->
+  179     withTempFile "txt" $ \progress -> do
+  180       writeFile progress ""
+  181       progressH <- openFile progress ReadMode
+  182       hSetBuffering progressH NoBuffering
+  183       allFinished <- newEmptyMVar
+  184       void $ forkIO $ do
+  185         progressPrinter "rendered" (animationFrameCount ani fps)
+  186           $ \done -> fix $ \loop -> do
+  187             eof <- hIsEOF progressH
+  188             if eof
+  189               then threadDelay 1000000 >> loop
+  190               else do
+  191                 l <- try (hGetLine progressH)
+  192                 case l of
+  193                   Left  SomeException{} -> return ()
+  194                   Right str             ->
+  195                     case take 6 str of
+  196                       "frame=" -> do
+  197                         void $ swapMVar done (read (drop 6 str))
+  198                         loop
+  199                       _ | str == "progress=end" -> return ()
+  200                       _                         -> loop
+  201         putMVar allFinished ()
+  202       case format of
+  203         RenderMp4 -> runCmd ffmpeg (mp4Arguments fps progress template target)
+  204         RenderGif -> withTempFile "png" $ \palette -> do
+  205           runCmd
+  206             ffmpeg
+  207             [ "-i"
+  208             , template
+  209             , "-y"
+  210             , "-vf"
+  211             , "fps="
+  212             ++ show fps
+  213             ++ ",scale="
+  214             ++ show width
+  215             ++ ":"
+  216             ++ show height
+  217             ++ ":flags=lanczos,palettegen"
+  218             , "-t"
+  219             , showFFloat Nothing (duration ani) ""
+  220             , palette
+  221             ]
+  222           runCmd
+  223             ffmpeg
+  224             [ "-framerate"
+  225             , show fps
+  226             , "-i"
+  227             , template
+  228             , "-y"
+  229             , "-i"
+  230             , palette
+  231             , "-progress"
+  232             , progress
+  233             , "-filter_complex"
+  234             , "fps="
+  235             ++ show fps
+  236             ++ ",scale="
+  237             ++ show width
+  238             ++ ":"
+  239             ++ show height
+  240             ++ ":flags=lanczos[x];[x][1:v]paletteuse"
+  241             , "-t"
+  242             , showFFloat Nothing (duration ani) ""
+  243             , target
+  244             ]
+  245         RenderWebm -> runCmd
+  246           ffmpeg
+  247           [ "-r"
+  248           , show fps
+  249           , "-i"
+  250           , template
+  251           , "-y"
+  252           , "-progress"
+  253           , progress
+  254           , "-c:v"
+  255           , "libvpx-vp9"
+  256           , "-vf"
+  257           , "fps=" ++ show fps
+  258           , target
+  259           ]
+  260       takeMVar allFinished
+  261 
+  262 ---------------------------------------------------------------------------------
+  263 -- Helpers
+  264 
+  265 progressPrinter :: String -> Int -> (MVar Int -> IO ()) -> IO ()
+  266 progressPrinter typeName maxCount action = do
+  267   printf "\rFrames %s: 0/%d" typeName maxCount
+  268   putStr $ clearFromCursorToLineEndCode ++ "\r"
+  269   done  <- newMVar (0 :: Int)
+  270   start <- getCurrentTime
+  271   let bgThread = forever $ do
+  272         nDone <- readMVar done
+  273         now   <- getCurrentTime
+  274         let spent = diffUTCTime now start
+  275             remaining =
+  276               (spent / (fromIntegral nDone / fromIntegral maxCount)) - spent
+  277         printf "\rFrames %s: %d/%d" typeName nDone maxCount
+  278         putStr $ ", time spent: " ++ ppDiff spent
+  279         unless (nDone == 0) $ do
+  280           putStr $ ", time remaining: " ++ ppDiff remaining
+  281           putStr $ ", total time: " ++ ppDiff (remaining + spent)
+  282         putStr $ clearFromCursorToLineEndCode ++ "\r"
+  283         hFlush stdout
+  284         threadDelay 1000000
+  285   withBackgroundThread bgThread $ action done
+  286   now <- getCurrentTime
+  287   let spent = diffUTCTime now start
+  288   printf "\rFrames %s: %d/%d" typeName maxCount maxCount
+  289   putStr $ ", time spent: " ++ ppDiff spent
+  290   putStr $ clearFromCursorToLineEndCode ++ "\n"
+  291 
+  292 animationFrameCount :: Animation -> FPS -> Int
+  293 animationFrameCount ani rate = round (duration ani * fromIntegral rate) :: Int
+  294 
+  295 generateFrames
+  296   :: Raster -> Animation -> Width -> Height -> FPS -> Bool -> (FilePath -> IO a) -> IO a
+  297 generateFrames raster ani width_ height_ rate partial action = withTempDir $ \tmp -> do
+  298   let frameName nth = tmp </> printf nameTemplate nth
+  299   setRootDirectory tmp
+  300   progressPrinter "generated" frameCount
+  301     $ \done -> handle h $ concurrentForM_ frames $ \n -> do
+  302         writeFile (frameName n) $ renderSvg width height $ nthFrame n
+  303         modifyMVar_ done $ \nDone -> return (nDone + 1)
+  304 
+  305   when (isValidRaster raster)
+  306     $ progressPrinter "rastered" frameCount
+  307     $ \done -> handle h $ concurrentForM_ frames $ \n -> do
+  308         applyRaster raster (frameName n)
+  309         modifyMVar_ done $ \nDone -> return (nDone + 1)
+  310 
+  311   action (tmp </> rasterTemplate raster)
+  312  where
+  313   isValidRaster RasterNone = False
+  314   isValidRaster RasterAuto = False
+  315   isValidRaster _          = True
+  316 
+  317   width  = Just $ Px $ fromIntegral width_
+  318   height = Just $ Px $ fromIntegral height_
+  319   h UserInterrupt | partial = do
+  320     hPutStrLn
+  321       stderr
+  322       "\nCtrl-C detected. Trying to generate video with available frames. \
+  323                        \Hit ctrl-c again to abort."
+  324     return ()
+  325   h other = throwIO other
+  326   -- frames = [0..frameCount-1]
+  327   frames = frameOrder rate frameCount
+  328   nthFrame nth = frameAt (recip (fromIntegral rate) * fromIntegral nth) ani
+  329   frameCount = animationFrameCount ani rate
+  330   nameTemplate :: String
+  331   nameTemplate = "render-%05d.svg"
+  332 
+  333 withBackgroundThread :: IO () -> IO a -> IO a
+  334 withBackgroundThread t = bracket (forkIO t) killThread . const
+  335 
+  336 ppDiff :: NominalDiffTime -> String
+  337 ppDiff diff | hours == 0 && mins == 0 = show secs ++ "s"
+  338             | hours == 0              = printf "%.2d:%.2d" mins secs
+  339             | otherwise               = printf "%.2d:%.2d:%.2d" hours mins secs
+  340  where
+  341   (osecs, secs) = round diff `divMod` (60 :: Int)
+  342   (hours, mins) = osecs `divMod` 60
+  343 
+  344 rasterTemplate :: Raster -> String
+  345 rasterTemplate RasterNone = "render-%05d.svg"
+  346 rasterTemplate RasterAuto = "render-%05d.svg"
+  347 rasterTemplate _          = "render-%05d.png"
+  348 
+  349 -- | Resolve RasterNone and RasterAuto. If no valid raster can
+  350 --   be found, exit with an error message.
+  351 requireRaster :: Raster -> IO Raster
+  352 requireRaster raster = do
+  353   raster' <- selectRaster (if raster == RasterNone then RasterAuto else raster)
+  354   case raster' of
+  355     RasterNone -> do
+  356       hPutStrLn
+  357         stderr
+  358         "Raster required but none could be found. \
+  359         \Please install either inkscape, imagemagick, or rsvg-convert."
+  360       exitWith (ExitFailure 1)
+  361     _ -> pure raster'
+  362 
+  363 -- | Resolve RasterNone and RasterAuto. If no valid raster can
+  364 --   be found, return RasterNone.
+  365 selectRaster :: Raster -> IO Raster
+  366 selectRaster RasterAuto = do
+  367   rsvg   <- hasRSvg
+  368   ink    <- hasInkscape
+  369   magick <- hasMagick
+  370   if
+  371     | isRight rsvg   -> pure RasterRSvg
+  372     | isRight ink    -> pure RasterInkscape
+  373     | isRight magick -> pure RasterMagick
+  374     | otherwise      -> pure RasterNone
+  375 selectRaster r = pure r
+  376 
+  377 -- | Convert SVG file to a PNG file with selected raster engine. If
+  378 --   raster engine is RasterAuto or RasterNone, do nothing.
+  379 applyRaster :: Raster -> FilePath -> IO ()
+  380 applyRaster RasterNone     _    = return ()
+  381 applyRaster RasterAuto     _    = return ()
+  382 applyRaster RasterInkscape path = runCmd
+  383   "inkscape"
+  384   [ "--without-gui"
+  385   , "--file=" ++ path
+  386   , "--export-png=" ++ replaceExtension path "png"
+  387   ]
+  388 applyRaster RasterRSvg path = runCmd
+  389   "rsvg-convert"
+  390   [path, "--unlimited", "--output", replaceExtension path "png"]
+  391 applyRaster RasterMagick path =
+  392   runCmd magickCmd [path, replaceExtension path "png"]
+  393 
+  394 concurrentForM_ :: [a] -> (a -> IO ()) -> IO ()
+  395 concurrentForM_ lst action = do
+  396   n    <- getNumCapabilities
+  397   sem  <- newQSemN n
+  398   eVar <- newEmptyMVar
+  399   forM_ lst $ \elt -> do
+  400     waitQSemN sem 1
+  401     emp <- isEmptyMVar eVar
+  402     if emp
+  403       then
+  404         void
+  405           $ forkIO
+  406               (         catch       (action elt) (void . tryPutMVar eVar)
+  407               `finally` signalQSemN sem          1
+  408               )
+  409       else signalQSemN sem 1
+  410   waitQSemN sem n
+  411   mbE <- tryTakeMVar eVar
+  412   case mbE of
+  413     Nothing -> return ()
+  414     Just e  -> throwIO (e :: SomeException)
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Scene.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Scene.hs.html new file mode 100644 index 0000000..b106b0c --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Scene.hs.html @@ -0,0 +1,1203 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE ApplicativeDo             #-}
+    2 {-# LANGUAGE ExistentialQuantification #-}
+    3 {-# LANGUAGE RankNTypes                #-}
+    4 {-# LANGUAGE RecordWildCards           #-}
+    5 {-|
+    6 Module      : Reanimate.Scene
+    7 Copyright   : Written by David Himmelstrup
+    8 License     : Unlicense
+    9 Maintainer  : lemmih@gmail.com
+   10 Stability   : experimental
+   11 Portability : POSIX
+   12 
+   13 Scenes are an imperative way of defining animations.
+   14 
+   15 -}
+   16 module Reanimate.Scene
+   17   ( -- * Scenes
+   18     Scene
+   19   , ZIndex
+   20   , scene             -- :: (forall s. Scene s a) -> Animation
+   21   , sceneAnimation    -- :: (forall s. Scene s a) -> Animation
+   22   , play              -- :: Animation -> Scene s ()
+   23   , fork              -- :: Scene s a -> Scene s a
+   24   , queryNow          -- :: Scene s Time
+   25   , wait              -- :: Duration -> Scene s ()
+   26   , waitUntil         -- :: Time -> Scene s ()
+   27   , waitOn            -- :: Scene s a -> Scene s a
+   28   , adjustZ           -- :: (ZIndex -> ZIndex) -> Scene s a -> Scene s a
+   29   , withSceneDuration -- :: Scene s () -> Scene s Duration
+   30   -- * Variables
+   31   , Var
+   32   , newVar            -- :: a -> Scene s (Var s a)
+   33   , readVar           -- :: Var s a -> Scene s a
+   34   , writeVar          -- :: Var s a -> a -> Scene s ()
+   35   , modifyVar         -- :: Var s a -> (a -> a) -> Scene s ()
+   36   , tweenVar          -- :: Var s a -> Duration -> (a -> Time -> a) -> Scene s ()
+   37   , tweenVarUnclamped -- :: Var s a -> Duration -> (a -> Time -> a) -> Scene s ()
+   38   , simpleVar         -- :: (a -> SVG) -> a -> Scene s (Var s a)
+   39   , findVar           -- :: (a -> Bool) -> [Var s a] -> Scene s (Var s a)
+   40   -- * Sprites
+   41   , Sprite
+   42   , Frame
+   43   , unVar             -- :: Var s a -> Frame s a
+   44   , spriteT           -- :: Frame s Time
+   45   , spriteDuration    -- :: Frame s Duration
+   46   , newSprite         -- :: Frame s SVG -> Scene s (Sprite s)
+   47   , newSprite_        -- :: Frame s SVG -> Scene s ()
+   48   , newSpriteA        -- :: Animation -> Scene s (Sprite s)
+   49   , newSpriteA'       -- :: Sync -> Animation -> Scene s (Sprite s)
+   50   , newSpriteSVG      -- :: SVG -> Scene s (Sprite s)
+   51   , newSpriteSVG_     -- :: SVG -> Scene s ()
+   52   , destroySprite     -- :: Sprite s -> Scene s ()
+   53   , applyVar          -- :: Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s ()
+   54   , spriteModify      -- :: Sprite s -> Frame s ((SVG,ZIndex) -> (SVG, ZIndex)) -> Scene s ()
+   55   , spriteMap         -- :: Sprite s -> (SVG -> SVG) -> Scene s ()
+   56   , spriteTween       -- :: Sprite s -> Duration -> (Double -> SVG -> SVG) -> Scene s ()
+   57   , spriteVar         -- :: Sprite s -> a -> (a -> SVG -> SVG) -> Scene s (Var s a)
+   58   , spriteE           -- :: Sprite s -> Effect -> Scene s ()
+   59   , spriteZ           -- :: Sprite s -> ZIndex -> Scene s ()
+   60   , spriteScope       -- :: Scene s a -> Scene s a
+   61 
+   62   -- * Object API
+   63   , Object
+   64   , ObjectData
+   65   , oNew
+   66   , newObject
+   67   , oModify
+   68   , oModifyS
+   69   , oRead
+   70   , oTween
+   71   , oTweenS
+   72   , oTweenV
+   73   , oTweenVS
+   74   , Renderable(..)
+   75   -- ** Object Properties
+   76   , oTranslate
+   77   , oSVG
+   78   , oContext
+   79   , oMargin
+   80   , oMarginTop
+   81   , oMarginRight
+   82   , oMarginBottom
+   83   , oMarginLeft
+   84   , oBB
+   85   , oBBMinX
+   86   , oBBMinY
+   87   , oBBWidth
+   88   , oBBHeight
+   89   , oOpacity
+   90   , oShown
+   91   , oZIndex
+   92   , oEasing
+   93   , oScale
+   94   , oScaleOrigin
+   95   , oTopY
+   96   , oBottomY
+   97   , oLeftX
+   98   , oRightX
+   99   , oCenterXY
+  100   , oValue
+  101 
+  102   -- ** Graphics object methods
+  103   , oShow
+  104   , oHide
+  105   , oFadeIn
+  106   , oFadeOut
+  107   , oGrow
+  108   , oShrink
+  109   , oTransform
+  110 
+  111   -- ** Pre-defined objects
+  112   , Circle(..)
+  113   , circleRadius
+  114   , Rectangle(..)
+  115   , rectWidth
+  116   , rectHeight
+  117   , Morph(..)
+  118   , morphDelta
+  119   , morphSrc
+  120   , morphDst
+  121   , Camera(..)
+  122   , cameraAttach
+  123   , cameraFocus
+  124   , cameraSetZoom
+  125   , cameraZoom
+  126   , cameraSetPan
+  127   , cameraPan
+  128 
+  129   -- * ST internals
+  130   , liftST
+  131   , transitionO
+  132   , evalScene
+  133   )
+  134 where
+  135 
+  136 import           Control.Lens
+  137 import           Control.Monad              (void)
+  138 import           Control.Monad.Fix
+  139 import           Control.Monad.ST
+  140 import           Control.Monad.State (execState, State)
+  141 import           Data.List
+  142 import           Data.STRef
+  143 import           Graphics.SvgTree           (Tree (None))
+  144 import           Reanimate.Animation
+  145 import           Reanimate.Ease             (Signal, curveS, fromToS)
+  146 import           Reanimate.Effect
+  147 import           Reanimate.Svg.Constructors
+  148 import           Reanimate.Svg.BoundingBox
+  149 import           Reanimate.Transition
+  150 import           Reanimate.Morph.Common (morph)
+  151 import           Reanimate.Morph.Linear (linear)
+  152 
+  153 -- | The ZIndex property specifies the stack order of sprites and animations. Elements
+  154 --   with a higher ZIndex will be drawn on top of elements with a lower index.
+  155 type ZIndex = Int
+  156 
+  157 
+  158 -- (seq duration, par duration)
+  159 -- [(Time, Animation, ZIndex)]
+  160 -- Map Time [(Animation, ZIndex)]
+  161 type Gen s = ST s (Duration -> Time -> (SVG, ZIndex))
+  162 -- | A 'Scene' represents a sequence of animations and variables
+  163 --   that change over time.
+  164 newtype Scene s a = M { unM :: Time -> ST s (a, Duration, Duration, [Gen s]) }
+  165 
+  166 instance Functor (Scene s) where
+  167   fmap f action = M $ \t -> do
+  168     (a, d1, d2, gens) <- unM action t
+  169     return (f a, d1, d2, gens)
+  170 
+  171 instance Applicative (Scene s) where
+  172   pure a = M $ \_ -> return (a, 0, 0, [])
+  173   f <*> g = M $ \t -> do
+  174     (f', s1, p1, gen1) <- unM f t
+  175     (g', s2, p2, gen2) <- unM g (t + s1)
+  176     return (f' g', s1 + s2, max p1 (s1 + p2), gen1 ++ gen2)
+  177 
+  178 instance Monad (Scene s) where
+  179   return = pure
+  180   f >>= g = M $ \t -> do
+  181     (a, s1, p1, gen1) <- unM f t
+  182     (b, s2, p2, gen2) <- unM (g a) (t + s1)
+  183     return (b, s1 + s2, max p1 (s1 + p2), gen1 ++ gen2)
+  184 
+  185 instance MonadFix (Scene s) where
+  186   mfix fn = M $ \t -> mfix (\v -> let (a, _s, _p, _gens) = v in unM (fn a) t)
+  187 
+  188 -- | Lift an ST action into the Scene monad.
+  189 liftST :: ST s a -> Scene s a
+  190 liftST action = M $ \_ -> action >>= \a -> return (a, 0, 0, [])
+  191 
+  192 -- | Evaluate the value of a scene.
+  193 evalScene :: (forall s . Scene s a) -> a
+  194 evalScene action = runST $ do
+  195   (val, _, _ , _) <- unM action 0
+  196   return val
+  197 
+  198 -- | Render a 'Scene' to an 'Animation'.
+  199 scene :: (forall s . Scene s a) -> Animation
+  200 scene = sceneAnimation
+  201 
+  202 -- | Render a 'Scene' to an 'Animation'.
+  203 sceneAnimation :: (forall s . Scene s a) -> Animation
+  204 sceneAnimation action = runST
+  205   (do
+  206     (_, s, p, gens) <- unM action 0
+  207     let dur = max s p
+  208     genFns <- sequence gens
+  209     return $ mkAnimation
+  210       dur
+  211       (\t -> mkGroup $ map fst $ sortOn
+  212         snd
+  213         [ spriteRender dur (t * dur) | spriteRender <- genFns ]
+  214       )
+  215   )
+  216 
+  217 -- | Execute actions in a scene without advancing the clock. Note that scenes do not end before
+  218 --   all forked actions have completed.
+  219 --
+  220 --   Example:
+  221 --
+  222 --   > do fork $ play drawBox
+  223 --   >    play drawCircle
+  224 --
+  225 --   <<docs/gifs/doc_fork.gif>>
+  226 fork :: Scene s a -> Scene s a
+  227 fork (M action) = M $ \t -> do
+  228   (a, s, p, gens) <- action t
+  229   return (a, 0, max s p, gens)
+  230 
+  231 -- | Play an animation once and then remove it. This advances the clock by the duration of the
+  232 --   animation.
+  233 --
+  234 --   Example:
+  235 --
+  236 --   > do play drawBox
+  237 --   >    play drawCircle
+  238 --
+  239 --   <<docs/gifs/doc_play.gif>>
+  240 play :: Animation -> Scene s ()
+  241 play ani = newSpriteA ani >>= destroySprite
+  242 
+  243 -- | Query the current clock timestamp.
+  244 --
+  245 --   Example:
+  246 --
+  247 --   > do now <- play drawCircle *> queryNow
+  248 --   >    play $ staticFrame 1 $ scale 2 $ withStrokeWidth 0.05 $
+  249 --   >      mkText $ "Now=" <> T.pack (show now)
+  250 --
+  251 --   <<docs/gifs/doc_queryNow.gif>>
+  252 queryNow :: Scene s Time
+  253 queryNow = M $ \t -> return (t, 0, 0, [])
+  254 
+  255 -- | Advance the clock by a given number of seconds.
+  256 --
+  257 --   Example:
+  258 --
+  259 --   > do fork $ play drawBox
+  260 --   >    wait 1
+  261 --   >    play drawCircle
+  262 --
+  263 --   <<docs/gifs/doc_wait.gif>>
+  264 wait :: Duration -> Scene s ()
+  265 wait d = M $ \_ -> return ((), d, 0, [])
+  266 
+  267 -- | Wait until the clock is equal to the given timestamp.
+  268 waitUntil :: Time -> Scene s ()
+  269 waitUntil tNew = do
+  270   now <- queryNow
+  271   wait (max 0 (tNew - now))
+  272 
+  273 -- | Wait until all forked and sequential animations have finished.
+  274 --
+  275 --   Example:
+  276 --
+  277 --   > do waitOn $ fork $ play drawBox
+  278 --   >    play drawCircle
+  279 --
+  280 --   <<docs/gifs/doc_waitOn.gif>>
+  281 waitOn :: Scene s a -> Scene s a
+  282 waitOn (M action) = M $ \t -> do
+  283   (a, s, p, gens) <- action t
+  284   return (a, max s p, 0, gens)
+  285 
+  286 -- | Change the ZIndex of a scene.
+  287 adjustZ :: (ZIndex -> ZIndex) -> Scene s a -> Scene s a
+  288 adjustZ fn (M action) = M $ \t -> do
+  289   (a, s, p, gens) <- action t
+  290   return (a, s, p, map genFn gens)
+  291  where
+  292   genFn gen = do
+  293     frameGen <- gen
+  294     return $ \d t -> let (svg, z) = frameGen d t in (svg, fn z)
+  295 
+  296 -- | Query the duration of a scene.
+  297 withSceneDuration :: Scene s () -> Scene s Duration
+  298 withSceneDuration s = do
+  299   t1 <- queryNow
+  300   s
+  301   t2 <- queryNow
+  302   return (t2 - t1)
+  303 
+  304 addGen :: Gen s -> Scene s ()
+  305 addGen gen = M $ \_ -> return ((), 0, 0, [gen])
+  306 
+  307 -- | Time dependent variable.
+  308 newtype Var s a = Var (STRef s (Time -> a))
+  309 
+  310 -- | Create a new variable with a default value.
+  311 --   Variables always have a defined value even if they are read at a timestamp that is
+  312 --   earlier than when the variable was created. For example:
+  313 --
+  314 --   > do v <- fork (wait 10 >> newVar 0) -- Create a variable at timestamp '10'.
+  315 --   >    readVar v                       -- Read the variable at timestamp '0'.
+  316 --   >                                    -- The value of the variable will be '0'.
+  317 newVar :: a -> Scene s (Var s a)
+  318 newVar def = Var <$> liftST (newSTRef (const def))
+  319 
+  320 -- | Read the value of a variable at the current timestamp.
+  321 readVar :: Var s a -> Scene s a
+  322 readVar (Var ref) = liftST (readSTRef ref) <*> queryNow
+  323 
+  324 -- | Write the value of a variable at the current timestamp.
+  325 --
+  326 --   Example:
+  327 --
+  328 --   > do v <- newVar 0
+  329 --   >    newSprite $ mkCircle <$> unVar v
+  330 --   >    writeVar v 1; wait 1
+  331 --   >    writeVar v 2; wait 1
+  332 --   >    writeVar v 3; wait 1
+  333 --
+  334 --   <<docs/gifs/doc_writeVar.gif>>
+  335 writeVar :: Var s a -> a -> Scene s ()
+  336 writeVar var val = modifyVar var (const val)
+  337 
+  338 -- | Modify the value of a variable at the current timestamp and all future timestamps.
+  339 modifyVar :: Var s a -> (a -> a) -> Scene s ()
+  340 modifyVar (Var ref) fn = do
+  341   now <- queryNow
+  342   liftST $ modifySTRef ref $ \prev t -> if t < now then prev t else fn (prev t)
+  343 
+  344 -- | Modify a variable between @now@ and @now+duration@.
+  345 --   Note: The modification function is invoked for past timestamps (with a time value of 0) and
+  346 --         for timestamps after @now+duration@ (with a time value of 1). See 'tweenVarUnclamped'.
+  347 tweenVar :: Var s a -> Duration -> (a -> Time -> a) -> Scene s ()
+  348 tweenVar (Var ref) dur fn = do
+  349   now <- queryNow
+  350   liftST $ modifySTRef ref $ \prev t ->
+  351     if t < now
+  352       then prev t
+  353       else fn (prev t) (max 0 (min dur $ t - now) / dur)
+  354   wait dur
+  355 
+  356 -- | Modify a variable between @now@ and @now+duration@.
+  357 --   Note: The modification function is invoked for past timestamps (with a negative time value) and
+  358 --         for timestamps after @now+duration@ (with a time value greater than 1).
+  359 tweenVarUnclamped :: Var s a -> Duration -> (a -> Time -> a) -> Scene s ()
+  360 tweenVarUnclamped (Var ref) dur fn = do
+  361   now <- queryNow
+  362   liftST $ modifySTRef ref $ \prev t -> fn (prev t) ((t - now) / dur)
+  363   wait dur
+  364 
+  365 -- | Create and render a variable. The rendering will be born at the current timestamp
+  366 --   and will persist until the end of the scene.
+  367 --
+  368 --   Example:
+  369 --
+  370 --   > do var <- simpleVar mkCircle 0
+  371 --   >    tweenVar var 2 $ \val -> fromToS val (screenHeight/2)
+  372 --
+  373 --   <<docs/gifs/doc_simpleVar.gif>>
+  374 simpleVar :: (a -> SVG) -> a -> Scene s (Var s a)
+  375 simpleVar render def = do
+  376   v <- newVar def
+  377   _ <- newSprite $ render <$> unVar v
+  378   return v
+  379 
+  380 -- | Helper function for filtering variables.
+  381 findVar :: (a -> Bool) -> [Var s a] -> Scene s (Var s a)
+  382 findVar _cond []       = error "Variable not found."
+  383 findVar cond  (v : vs) = do
+  384   val <- readVar v
+  385   if cond val then return v else findVar cond vs
+  386 
+  387 -- | Sprites are animations with a given time of birth as well as a time of death.
+  388 --   They can be controlled using variables, tweening, and effects.
+  389 data Sprite s = Sprite Time (STRef s (Duration, ST s (Duration -> Time -> SVG -> (SVG, ZIndex))))
+  390 
+  391 -- | Sprite frame generator. Generates frames over time in a stateful environment.
+  392 newtype Frame s a = Frame { unFrame :: ST s (Time -> Duration -> Time -> a) }
+  393 
+  394 instance Functor (Frame s) where
+  395   fmap fn (Frame gen) = Frame $ do
+  396     m <- gen
+  397     return (\real_t d t -> fn $ m real_t d t)
+  398 
+  399 instance Applicative (Frame s) where
+  400   pure v = Frame $ return (\_ _ _ -> v)
+  401   Frame f <*> Frame g = Frame $ do
+  402     m1 <- f
+  403     m2 <- g
+  404     return $ \real_t d t -> m1 real_t d t (m2 real_t d t)
+  405 
+  406 -- | Dereference a variable as a Sprite frame.
+  407 --
+  408 --   Example:
+  409 --
+  410 --   > do v <- newVar 0
+  411 --   >    newSprite $ mkCircle <$> unVar v
+  412 --   >    tweenVar v 1 $ \val -> fromToS val 3
+  413 --   >    tweenVar v 1 $ \val -> fromToS val 0
+  414 --
+  415 --   <<docs/gifs/doc_unVar.gif>>
+  416 unVar :: Var s a -> Frame s a
+  417 unVar (Var ref) = Frame $ do
+  418   fn <- readSTRef ref
+  419   return $ \real_t _d _t -> fn real_t
+  420 
+  421 
+  422 -- | Dereference seconds since sprite birth.
+  423 spriteT :: Frame s Time
+  424 spriteT = Frame $ return (\_real_t _d t -> t)
+  425 
+  426 -- | Dereference duration of the current sprite.
+  427 spriteDuration :: Frame s Duration
+  428 spriteDuration = Frame $ return (\_real_t d _t -> d)
+  429 
+  430 -- | Create new sprite defined by a frame generator. Unless otherwise specified using
+  431 --   'destroySprite', the sprite will die at the end of the scene.
+  432 --
+  433 --   Example:
+  434 --
+  435 --   > do newSprite $ mkCircle <$> spriteT -- Circle sprite where radius=time.
+  436 --   >    wait 2
+  437 --
+  438 --   <<docs/gifs/doc_newSprite.gif>>
+  439 newSprite :: Frame s SVG -> Scene s (Sprite s)
+  440 newSprite render = do
+  441   now <- queryNow
+  442   ref <- liftST $ newSTRef (-1, return $ \_d _t svg -> (svg, 0))
+  443   addGen $ do
+  444     fn                           <- unFrame render
+  445     (spriteDur, spriteEffectGen) <- readSTRef ref
+  446     spriteEffect                 <- spriteEffectGen
+  447     return $ \d absT ->
+  448       let relD = (if spriteDur < 0 then d else spriteDur) - now
+  449           relT = absT - now
+  450           -- Sprite is live [now;duration[
+  451           -- If we're at the end of a scene, sprites
+  452           -- are live: [now;duration]
+  453           -- This behavior is difficult to get right. See the 'bug_*' examples for
+  454           -- automated tests.
+  455           inTimeSlice = relT >= 0 && relT < relD
+  456           isLastFrame = d==absT && relT == relD
+  457       in  if inTimeSlice || isLastFrame
+  458             then spriteEffect relD relT (fn absT relD relT)
+  459             else (None, 0)
+  460   return $ Sprite now ref
+  461 
+  462 -- | Create new sprite defined by a frame generator. The sprite will die at
+  463 --   the end of the scene.
+  464 newSprite_ :: Frame s SVG -> Scene s ()
+  465 newSprite_ = void . newSprite
+  466 
+  467 -- | Create a new sprite from an animation. This advances the clock by the
+  468 --   duration of the animation. Unless otherwise specified using
+  469 --   'destroySprite', the sprite will die at the end of the scene.
+  470 --
+  471 --   Note: If the scene doesn't end immediately after the duration of the
+  472 --   animation, the animation will be stretched to match the lifetime of the
+  473 --   sprite. See 'newSpriteA'' and 'play'.
+  474 --
+  475 --   Example:
+  476 --
+  477 --   > do fork $ newSpriteA drawCircle
+  478 --   >    play drawBox
+  479 --   >    play $ reverseA drawBox
+  480 --
+  481 --   <<docs/gifs/doc_newSpriteA.gif>>
+  482 newSpriteA :: Animation -> Scene s (Sprite s)
+  483 newSpriteA = newSpriteA' SyncStretch
+  484 
+  485 -- | Create a new sprite from an animation and specify the synchronization policy. This advances
+  486 --   the clock by the duration of the animation.
+  487 --
+  488 --   Example:
+  489 --
+  490 --   > do fork $ newSpriteA' SyncFreeze drawCircle
+  491 --   >    play drawBox
+  492 --   >    play $ reverseA drawBox
+  493 --
+  494 --   <<docs/gifs/doc_newSpriteA'.gif>>
+  495 newSpriteA' :: Sync -> Animation -> Scene s (Sprite s)
+  496 newSpriteA' sync animation =
+  497   newSprite (getAnimationFrame sync animation <$> spriteT <*> spriteDuration)
+  498     <* wait (duration animation)
+  499 
+  500 -- | Create a sprite from a static SVG image.
+  501 --
+  502 --   Example:
+  503 --
+  504 --   > do newSpriteSVG $ mkBackground "lightblue"
+  505 --   >    play drawCircle
+  506 --
+  507 --   <<docs/gifs/doc_newSpriteSVG.gif>>
+  508 newSpriteSVG :: SVG -> Scene s (Sprite s)
+  509 newSpriteSVG = newSprite . pure
+  510 
+  511 -- | Create a permanent sprite from a static SVG image. Same as `newSpriteSVG`
+  512 --   but the sprite isn't returned and thus cannot be destroyed.
+  513 newSpriteSVG_ :: SVG -> Scene s ()
+  514 newSpriteSVG_ = void . newSpriteSVG
+  515 
+  516 -- | Change the rendering of a sprite using data from a variable. If data from several variables
+  517 --   is needed, use a frame generator instead.
+  518 --
+  519 --   Example:
+  520 --
+  521 --   > do s <- fork $ newSpriteA drawBox
+  522 --   >    v <- newVar 0
+  523 --   >    applyVar v s rotate
+  524 --   >    tweenVar v 2 $ \val -> fromToS val 90
+  525 --
+  526 --   <<docs/gifs/doc_applyVar.gif>>
+  527 applyVar :: Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s ()
+  528 applyVar var sprite fn = spriteModify sprite $ do
+  529   varFn <- unVar var
+  530   return $ \(svg, zindex) -> (fn varFn svg, zindex)
+  531 
+  532 -- | Destroy a sprite, preventing it from being rendered in the future of the scene.
+  533 --   If 'destroySprite' is invoked multiple times, the earliest time-of-death is used.
+  534 --
+  535 --   Example:
+  536 --
+  537 --   > do s <- newSpriteSVG $ withFillOpacity 1 $ mkCircle 1
+  538 --   >    fork $ wait 1 >> destroySprite s
+  539 --   >    play drawBox
+  540 --
+  541 --   <<docs/gifs/doc_destroySprite.gif>>
+  542 destroySprite :: Sprite s -> Scene s ()
+  543 destroySprite (Sprite _ ref) = do
+  544   now <- queryNow
+  545   liftST $ modifySTRef ref $ \(ttl, render) ->
+  546     (if ttl < 0 then now else min ttl now, render)
+  547 
+  548 -- | Low-level frame modifier.
+  549 spriteModify :: Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
+  550 spriteModify (Sprite born ref) modFn = liftST $ modifySTRef ref $ \(ttl, renderGen) ->
+  551   ( ttl
+  552   , do
+  553     render    <- renderGen
+  554     modRender <- unFrame modFn
+  555     return $ \relD relT ->
+  556       let absT = relT + born in modRender absT relD relT . render relD relT
+  557   )
+  558 
+  559 -- | Map the SVG output of a sprite.
+  560 --
+  561 --   Example:
+  562 --
+  563 --   > do s <- fork $ newSpriteA drawCircle
+  564 --   >    wait 1
+  565 --   >    spriteMap s flipYAxis
+  566 --
+  567 --   <<docs/gifs/doc_spriteMap.gif>>
+  568 spriteMap :: Sprite s -> (SVG -> SVG) -> Scene s ()
+  569 spriteMap sprite@(Sprite born _) fn = do
+  570   now <- queryNow
+  571   let tDelta = now - born
+  572   spriteModify sprite $ do
+  573     t <- spriteT
+  574     return $ \(svg, zindex) -> (if (t - tDelta) < 0 then svg else fn svg, zindex)
+  575 
+  576 -- | Modify the output of a sprite between @now@ and @now+duration@.
+  577 --
+  578 --   Example:
+  579 --
+  580 --   > do s <- fork $ newSpriteA drawCircle
+  581 --   >    spriteTween s 1 $ \val -> translate (screenWidth*0.3*val) 0
+  582 --
+  583 --   <<docs/gifs/doc_spriteTween.gif>>
+  584 spriteTween :: Sprite s -> Duration -> (Double -> SVG -> SVG) -> Scene s ()
+  585 spriteTween sprite@(Sprite born _) dur fn = do
+  586   now <- queryNow
+  587   let tDelta = now - born
+  588   spriteModify sprite $ do
+  589     t <- spriteT
+  590     return $ \(svg, zindex) -> (fn (clamp 0 1 $ (t - tDelta) / dur) svg, zindex)
+  591   wait dur
+  592  where
+  593   clamp a b v | v < a     = a
+  594               | v > b     = b
+  595               | otherwise = v
+  596 
+  597 -- | Create a new variable and apply it to a sprite.
+  598 --
+  599 --   Example:
+  600 --
+  601 --   > do s <- fork $ newSpriteA drawBox
+  602 --   >    v <- spriteVar s 0 rotate
+  603 --   >    tweenVar v 2 $ \val -> fromToS val 90
+  604 --
+  605 --   <<docs/gifs/doc_spriteVar.gif>>
+  606 spriteVar :: Sprite s -> a -> (a -> SVG -> SVG) -> Scene s (Var s a)
+  607 spriteVar sprite def fn = do
+  608   v <- newVar def
+  609   applyVar v sprite fn
+  610   return v
+  611 
+  612 -- | Apply an effect to a sprite.
+  613 --
+  614 --   Example:
+  615 --
+  616 --   > do s <- fork $ newSpriteA drawCircle
+  617 --   >    spriteE s $ overBeginning 1 fadeInE
+  618 --   >    spriteE s $ overEnding 0.5 fadeOutE
+  619 --
+  620 --   <<docs/gifs/doc_spriteE.gif>>
+  621 spriteE :: Sprite s -> Effect -> Scene s ()
+  622 spriteE (Sprite born ref) effect = do
+  623   now <- queryNow
+  624   liftST $ modifySTRef ref $ \(ttl, renderGen) ->
+  625     ( ttl
+  626     , do
+  627       render <- renderGen
+  628       return $ \d t svg ->
+  629         let (svg', z) = render d t svg
+  630         in  (delayE (max 0 $ now - born) effect d t svg', z)
+  631     )
+  632 
+  633 -- | Set new ZIndex of a sprite.
+  634 --
+  635 --   Example:
+  636 --
+  637 --   > do s1 <- newSpriteSVG $ withFillOpacity 1 $ withFillColor "blue" $ mkCircle 3
+  638 --   >    newSpriteSVG $ withFillOpacity 1 $ withFillColor "red" $ mkRect 8 3
+  639 --   >    wait 1
+  640 --   >    spriteZ s1 1
+  641 --   >    wait 1
+  642 --
+  643 --   <<docs/gifs/doc_spriteZ.gif>>
+  644 spriteZ :: Sprite s -> ZIndex -> Scene s ()
+  645 spriteZ (Sprite born ref) zindex = do
+  646   now <- queryNow
+  647   liftST $ modifySTRef ref $ \(ttl, renderGen) ->
+  648     ( ttl
+  649     , do
+  650       render <- renderGen
+  651       return $ \d t svg ->
+  652         let (svg', z) = render d t svg in (svg', if t < now - born then z else zindex)
+  653     )
+  654 
+  655 -- | Destroy all local sprites at the end of a scene.
+  656 --
+  657 --   Example:
+  658 --
+  659 --   > do -- the rect lives through the entire 3s animation
+  660 --   >    newSpriteSVG_ $ translate (-3) 0 $ mkRect 4 4
+  661 --   >    wait 1
+  662 --   >    spriteScope $ do
+  663 --   >      -- the circle only lives for 1 second.
+  664 --   >      local <- newSpriteSVG $ translate 3 0 $ mkCircle 2
+  665 --   >      spriteE local $ overBeginning 0.3 fadeInE
+  666 --   >      spriteE local $ overEnding 0.3 fadeOutE
+  667 --   >      wait 1
+  668 --   >    wait 1
+  669 --
+  670 --   <<docs/gifs/doc_spriteScope.gif>>
+  671 spriteScope :: Scene s a -> Scene s a
+  672 spriteScope (M action) = M $ \t -> do
+  673   (a, s, p, gens) <- action t
+  674   return (a, s, p, map (genFn (t+max s p)) gens)
+  675  where
+  676   genFn maxT gen = do
+  677     frameGen <- gen
+  678     return $ \_ t ->
+  679       if t < maxT
+  680         then frameGen maxT t
+  681         else (None, 0)
+  682 
+  683 asAnimation :: (forall s'. Scene s' a) -> Scene s Animation
+  684 asAnimation s = do
+  685   now <- queryNow
+  686   return $ dropA now (sceneAnimation (wait now >> s))
+  687 
+  688 -- | Apply a transformation with a given overlap. This makes sure
+  689 --   to keep timestamps intact such that events can still be timed
+  690 --   by transcripts.
+  691 transitionO :: Transition -> Double -> (forall s'. Scene s' a) -> (forall s'. Scene s' b) -> Scene s ()
+  692 transitionO t o a b = do
+  693   aA <- asAnimation a
+  694   bA <- fork $ do
+  695     wait (duration aA - o)
+  696     asAnimation b
+  697   play $ overlapT o t aA bA
+  698 
+  699 
+  700 
+  701 
+  702 -------------------------------------------------------
+  703 -- Objects
+  704 
+  705 -- | Objects can be any Haskell structure as long as it can be rendered to SVG.
+  706 class Renderable a where
+  707   toSVG :: a -> SVG
+  708 
+  709 instance Renderable Tree where
+  710   toSVG = id
+  711 
+  712 -- | Objects are SVG nodes (represented as Haskell values) with
+  713 --   identity, location, and several other properties that can
+  714 --   change over time.
+  715 data Object s a = Object
+  716   { objectSprite :: Sprite s
+  717   , objectData   :: Var s (ObjectData a)
+  718   }
+  719 
+  720 -- | Container for object properties.
+  721 data ObjectData a = ObjectData
+  722   { _oTranslate   :: (Double, Double)
+  723   , _oValueRef    :: a
+  724   , _oSVG         :: SVG
+  725   , _oContext     :: SVG -> SVG
+  726   , _oMargin      :: (Double, Double, Double, Double)
+  727       -- ^ Top, right, bottom, left
+  728   , _oBB          :: (Double,Double,Double,Double)
+  729   , _oOpacity     :: Double
+  730   , _oShown       :: Bool
+  731   , _oZIndex      :: Int
+  732   , _oEasing      :: Signal
+  733   , _oScale       :: Double
+  734   , _oScaleOrigin :: (Double, Double)
+  735   }
+  736 
+  737 -- Basic lenses
+  738 
+  739 -- FIXME: Maybe 'position' is a better name.
+  740 -- | Object position. Default: \<0,0\>
+  741 oTranslate :: Lens' (ObjectData a) (Double, Double)
+  742 oTranslate = lens _oTranslate $ \obj val -> obj { _oTranslate = val }
+  743 
+  744 -- | Rendered SVG node of an object. Does not include context
+  745 --   or object properties. Read-only.
+  746 oSVG :: Getter (ObjectData a) SVG
+  747 oSVG = to _oSVG
+  748 
+  749 -- | Custom render context. Is applied to the object for every
+  750 --   frame that it is shown.
+  751 oContext :: Lens' (ObjectData a) (SVG -> SVG)
+  752 oContext = lens _oContext $ \obj val -> obj { _oContext = val  }
+  753 
+  754 -- | Object margins (top, right, bottom, left) in local units.
+  755 oMargin :: Lens' (ObjectData a) (Double, Double, Double, Double)
+  756 oMargin = lens _oMargin $ \obj val -> obj { _oMargin = val }
+  757 
+  758 -- | Object bounding-box (minimal X-coordinate, minimal Y-coordinate,
+  759 --   width, height). Uses `Reanimate.Svg.BoundingBox.boundingBox`
+  760 --   and has the same limitations.
+  761 oBB :: Getter (ObjectData a) (Double, Double, Double, Double)
+  762 oBB = to _oBB
+  763 
+  764 -- | Object opacity. Default: 1
+  765 oOpacity :: Lens' (ObjectData a) Double
+  766 oOpacity = lens _oOpacity $ \obj val -> obj { _oOpacity = val }
+  767 
+  768 -- | Toggle for whether or not the object should be rendered.
+  769 --   Default: False
+  770 oShown :: Lens' (ObjectData a) Bool
+  771 oShown = lens _oShown $ \obj val -> obj { _oShown = val }
+  772 
+  773 -- | Object's z-index.
+  774 oZIndex :: Lens' (ObjectData a) Int
+  775 oZIndex = lens _oZIndex $ \obj val -> obj { _oZIndex = val }
+  776 
+  777 -- | Easing function used when modifying object properties.
+  778 --   Default: @'Reanimate.Ease.curveS' 2@
+  779 oEasing :: Lens' (ObjectData a) Signal
+  780 oEasing = lens _oEasing $ \obj val -> obj { _oEasing = val }
+  781 
+  782 -- | Object's scale. Default: 1
+  783 oScale :: Lens' (ObjectData a) Double
+  784 oScale = lens _oScale $ \obj val -> obj { _oScale = val }
+  785 
+  786 -- | Origin point for scaling. Default: \<0,0\>
+  787 oScaleOrigin :: Lens' (ObjectData a) (Double, Double)
+  788 oScaleOrigin = lens _oScaleOrigin $ \obj val -> obj { _oScaleOrigin = val }
+  789 
+  790 -- Smart lenses
+  791 
+  792 -- | Lens for the source value contained in an object.
+  793 oValue :: Renderable a => Lens' (ObjectData a) a
+  794 oValue = lens _oValueRef $ \obj newVal ->
+  795     let svg = toSVG newVal
+  796     in obj
+  797     { _oValueRef = newVal
+  798     , _oSVG      = svg
+  799     , _oBB       = boundingBox svg }
+  800 
+  801 -- | Derived location of the top-most point of an object + margin.
+  802 oTopY :: Lens' (ObjectData a) Double
+  803 oTopY = lens getter setter
+  804   where
+  805     getter obj = 
+  806       let top  = obj ^. oMarginTop
+  807           miny = obj ^. oBBMinY
+  808           h    = obj ^. oBBHeight
+  809           dy   = obj ^. oTranslate . _2
+  810       in dy+miny+h+top
+  811     setter obj val =
+  812       obj & (oTranslate . _2) +~ val-getter obj
+  813 
+  814 -- | Derived location of the bottom-most point of an object + margin.
+  815 oBottomY :: Lens' (ObjectData a) Double
+  816 oBottomY = lens getter setter
+  817   where
+  818     getter obj = 
+  819       let bot  = obj ^. oMarginBottom
+  820           miny = obj ^. oBBMinY
+  821           dy   = obj ^. oTranslate . _2
+  822       in dy+miny-bot
+  823     setter obj val = 
+  824       obj & (oTranslate . _2) +~ val-getter obj
+  825 
+  826 -- | Derived location of the left-most point of an object + margin.
+  827 oLeftX :: Lens' (ObjectData a) Double
+  828 oLeftX = lens getter setter
+  829   where
+  830     getter obj =
+  831       let left = obj ^. oMarginLeft
+  832           minx = obj ^. oBBMinX
+  833           dx   = obj ^. oTranslate . _1
+  834       in dx+minx-left
+  835     setter obj val =
+  836       obj & (oTranslate . _1) +~ val-getter obj
+  837 
+  838 -- | Derived location of the right-most point of an object + margin.
+  839 oRightX :: Lens' (ObjectData a) Double
+  840 oRightX = lens getter setter
+  841   where
+  842     getter obj =
+  843       let right = obj ^. oMarginRight
+  844           minx  = obj ^. oBBMinX
+  845           w     = obj ^. oBBWidth
+  846           dx    = obj ^. oTranslate . _1
+  847       in dx+minx+w+right
+  848     setter obj val =
+  849       obj & (oTranslate . _1) +~ val-getter obj
+  850 
+  851 -- | Derived location of an object's center point.
+  852 oCenterXY :: Lens' (ObjectData a) (Double, Double)
+  853 oCenterXY = lens getter setter
+  854   where
+  855     getter obj =
+  856       let minx    = obj ^. oBBMinX
+  857           miny    = obj ^. oBBMinY
+  858           w       = obj ^. oBBWidth
+  859           h       = obj ^. oBBHeight
+  860           (dx,dy) = obj ^. oTranslate
+  861       in (dx+minx+w/2, dy+miny+h/2)
+  862     setter obj (dx, dy) =
+  863       let (x,y) = getter obj in
+  864       obj & (oTranslate . _1) +~ dx-x
+  865           & (oTranslate . _2) +~ dy-y
+  866 
+  867 -- | Object's top margin.
+  868 oMarginTop :: Lens' (ObjectData a) Double
+  869 oMarginTop = oMargin . _1
+  870 
+  871 -- | Object's right margin.
+  872 oMarginRight :: Lens' (ObjectData a) Double
+  873 oMarginRight = oMargin . _2
+  874 
+  875 -- | Object's bottom margin.
+  876 oMarginBottom :: Lens' (ObjectData a) Double
+  877 oMarginBottom = oMargin . _3
+  878 
+  879 -- | Object's left margin.
+  880 oMarginLeft :: Lens' (ObjectData a) Double
+  881 oMarginLeft = oMargin . _4
+  882 
+  883 -- | Object's minimal X-coordinate..
+  884 oBBMinX :: Getter (ObjectData a) Double
+  885 oBBMinX = oBB . _1
+  886 
+  887 -- | Object's minimal Y-coordinate..
+  888 oBBMinY :: Getter (ObjectData a) Double
+  889 oBBMinY = oBB . _2
+  890 
+  891 -- | Object's width without margin.
+  892 oBBWidth :: Getter (ObjectData a) Double
+  893 oBBWidth = oBB . _3
+  894 
+  895 -- | Object's height without margin.
+  896 oBBHeight :: Getter (ObjectData a) Double
+  897 oBBHeight = oBB . _4
+  898 
+  899 -------------------------------------------------------------------------------
+  900 -- Object modifiers
+  901 
+  902 -- | Modify object properties.
+  903 oModify :: Object s a -> (ObjectData a -> ObjectData a) -> Scene s ()
+  904 oModify o fn = modifyVar (objectData o) fn
+  905 
+  906 -- | Modify object properties using a stateful API.
+  907 oModifyS :: Object s a -> (State (ObjectData a) b) -> Scene s ()
+  908 oModifyS o fn = oModify o (execState fn)
+  909 
+  910 -- | Query object property.
+  911 oRead :: Object s a -> Getting b (ObjectData a) b -> Scene s b
+  912 oRead o l = view l <$> readVar (objectData o)
+  913 
+  914 -- | Modify object properties over a set duration.
+  915 oTween :: Object s a -> Duration -> (Double -> ObjectData a -> ObjectData a) -> Scene s ()
+  916 oTween o d fn = do
+  917   -- Read 'easing' var here instead of taking it from 'v'.
+  918   -- This allows different easing functions even at the same timestamp.
+  919   ease <- oRead o oEasing
+  920   tweenVar (objectData o) d (\v t -> fn (ease t) v)
+  921 
+  922 -- | Modify object properties over a set duration using a stateful API.
+  923 oTweenS :: Object s a -> Duration -> (Double -> State (ObjectData a) b) -> Scene s ()
+  924 oTweenS o d fn = oTween o d (\t -> execState (fn t))
+  925 
+  926 -- | Modify object value over a set duration. This is a convenience function
+  927 --   for modifying `oValue`.
+  928 oTweenV :: Renderable a => Object s a -> Duration -> (Double -> a -> a) -> Scene s ()
+  929 oTweenV o d fn = oTween o d (\t -> oValue %~ fn t)
+  930 
+  931 -- | Modify object value over a set duration using a stateful API. This is a
+  932 --   convenience function for modifying `oValue`.
+  933 oTweenVS :: Renderable a => Object s a -> Duration -> (Double -> State a b) -> Scene s ()
+  934 oTweenVS o d fn = oTween o d (\t -> oValue %~ execState (fn t))
+  935 
+  936 -- | Create new object.
+  937 oNew :: Renderable a => a -> Scene s (Object s a)
+  938 oNew = newObject
+  939 
+  940 -- | Create new object.
+  941 newObject :: Renderable a => a -> Scene s (Object s a)
+  942 newObject val = do
+  943   ref <- newVar ObjectData
+  944     { _oTranslate = (0,0)
+  945     , _oValueRef = val
+  946     , _oSVG = svg
+  947     , _oContext = id
+  948     , _oMargin = (0.5,0.5,0.5,0.5)
+  949     , _oBB = boundingBox svg
+  950     , _oOpacity = 1
+  951     , _oShown = False
+  952     , _oZIndex = 1
+  953     , _oEasing = curveS 2
+  954     , _oScale = 1
+  955     , _oScaleOrigin = (0,0)
+  956     }
+  957   sprite <- newSprite $ do
+  958     ~ObjectData{..} <- unVar ref
+  959     pure $
+  960       if _oShown
+  961         then
+  962           uncurry translate _oTranslate $
+  963           uncurry translate (_oScaleOrigin & both %~ negate) $
+  964           scale _oScale $
+  965           uncurry translate _oScaleOrigin $
+  966           withGroupOpacity _oOpacity $
+  967           _oContext _oSVG
+  968         else None
+  969   spriteModify sprite $ do
+  970     ~ObjectData{_oZIndex=z} <- unVar ref
+  971     pure $ \(img,_) -> (img,z)
+  972   return Object
+  973     { objectSprite = sprite
+  974     , objectData   = ref }
+  975   where
+  976     svg = toSVG val
+  977 
+  978 -------------------------------------------------------------------------------
+  979 -- Graphical transformations
+  980 
+  981 -- | Instantly show object.
+  982 oShow :: Object s a -> Scene s ()
+  983 oShow o = oModify o $ oShown .~ True
+  984 
+  985 -- | Instantly hide object.
+  986 oHide :: Object s a -> Scene s ()
+  987 oHide o = oModify o $ oShown .~ False
+  988 
+  989 -- | Fade in object over a set duration.
+  990 oFadeIn :: Object s a -> Duration -> Scene s ()
+  991 oFadeIn o d = do
+  992   oModify o $ 
+  993     oShown   .~ True
+  994   oTweenS o d $ \t ->
+  995     oOpacity *= t
+  996 
+  997 -- | Fade out object over a set duration.
+  998 oFadeOut :: Object s a -> Duration -> Scene s ()
+  999 oFadeOut o d = do
+ 1000   oModify o $ 
+ 1001     oShown   .~ True
+ 1002   oTweenS o d $ \t ->
+ 1003     oOpacity *= 1-t
+ 1004 
+ 1005 -- | Scale in object over a set duration.
+ 1006 oGrow :: Object s a -> Duration -> Scene s ()
+ 1007 oGrow o d = do
+ 1008   oModify o $ 
+ 1009     oShown .~ True
+ 1010   oTweenS o d $ \t ->
+ 1011     oScale *= t
+ 1012 
+ 1013 -- | Scale out object over a set duration.
+ 1014 oShrink :: Object s a -> Duration -> Scene s ()
+ 1015 oShrink o d =
+ 1016   oTweenS o d $ \t ->
+ 1017     oScale *= 1-t
+ 1018 
+ 1019 -- FIXME: Also transform attributes: 'opacity', 'scale', 'scaleOrigin'.
+ 1020 -- | Morph source object into target object over a set duration.
+ 1021 oTransform :: Object s a -> Object s b -> Duration -> Scene s ()
+ 1022 oTransform src dst d = do
+ 1023     srcSvg <- oRead src oSVG
+ 1024     srcCtx <- oRead src oContext
+ 1025     srcEase <- oRead src oEasing
+ 1026     srcLoc <- oRead src oTranslate
+ 1027     oModify src $ oShown .~ False
+ 1028     
+ 1029     dstSvg <- oRead dst oSVG
+ 1030     dstCtx <- oRead dst oContext
+ 1031     dstLoc <- oRead dst oTranslate
+ 1032 
+ 1033     m <- newObject $ Morph 0 (srcCtx srcSvg) (dstCtx dstSvg)
+ 1034     oModifyS m $ do
+ 1035       oShown     .= True
+ 1036       oEasing    .= srcEase
+ 1037       oTranslate .= srcLoc
+ 1038     fork $ oTween m d $ \t -> oTranslate %~ moveTo t dstLoc
+ 1039     oTweenV m d $ \t -> morphDelta .~ t
+ 1040     oModify m $ oShown .~ False
+ 1041     oModify dst $ oShown .~ True
+ 1042   where
+ 1043     moveTo t (dstX, dstY) (srcX, srcY) =
+ 1044       (fromToS srcX dstX t, fromToS srcY dstY t)
+ 1045 
+ 1046 
+ 1047 -------------------------------------------------------------------------------
+ 1048 -- Built-in objects
+ 1049 
+ 1050 -- | Basic object mapping to \<circle\/\> in SVG.
+ 1051 newtype Circle = Circle {_circleRadius :: Double}
+ 1052 
+ 1053 -- | Circle radius in local units.
+ 1054 circleRadius :: Lens' Circle Double
+ 1055 circleRadius = iso _circleRadius Circle
+ 1056 
+ 1057 instance Renderable Circle where
+ 1058   toSVG (Circle r) = mkCircle r
+ 1059 
+ 1060 -- | Basic object mapping to \<rect\/\> in SVG.
+ 1061 data Rectangle = Rectangle { _rectWidth :: Double, _rectHeight :: Double }
+ 1062 
+ 1063 -- | Rectangle width in local units.
+ 1064 rectWidth :: Lens' Rectangle Double
+ 1065 rectWidth = lens _rectWidth $ \obj val -> obj{_rectWidth=val}
+ 1066 
+ 1067 -- | Rectangle height in local units.
+ 1068 rectHeight :: Lens' Rectangle Double
+ 1069 rectHeight = lens _rectHeight $ \obj val -> obj{_rectHeight=val}
+ 1070 
+ 1071 instance Renderable Rectangle where
+ 1072   toSVG (Rectangle w h) = mkRect w h
+ 1073 
+ 1074 -- | Object representing an interpolation between SVG nodes.
+ 1075 data Morph = Morph { _morphDelta :: Double, _morphSrc :: SVG, _morphDst :: SVG }
+ 1076 
+ 1077 -- | Control variable for the interpolation. A value of 0 gives the
+ 1078 --   source SVG and 1 gives the target svg.
+ 1079 morphDelta :: Lens' Morph Double
+ 1080 morphDelta = lens _morphDelta $ \obj val -> obj{_morphDelta = val}
+ 1081 
+ 1082 -- | Source shape.
+ 1083 morphSrc :: Lens' Morph SVG
+ 1084 morphSrc = lens _morphSrc $ \obj val -> obj{_morphSrc = val}
+ 1085 
+ 1086 -- | Target shape.
+ 1087 morphDst :: Lens' Morph SVG
+ 1088 morphDst = lens _morphDst $ \obj val -> obj{_morphDst = val}
+ 1089 
+ 1090 instance Renderable Morph where
+ 1091   toSVG (Morph t src dst) = morph linear src dst t
+ 1092 
+ 1093 -- | Cameras can take control of objects and manipulate them
+ 1094 --   with convenient pan and zoom operations.
+ 1095 data Camera = Camera
+ 1096 instance Renderable Camera where
+ 1097   toSVG Camera = None
+ 1098 
+ 1099 -- | Connect an object to a camera such that
+ 1100 --   camera settings (position, zoom, and rotation) is
+ 1101 --   applied to the object.
+ 1102 --
+ 1103 --   Example
+ 1104 --
+ 1105 --   > do cam <- newObject Camera
+ 1106 --   >    circ <- newObject $ Circle 2
+ 1107 --   >    oModifyS circ $
+ 1108 --   >      oContext .= withFillOpacity 1 . withFillColor "blue"
+ 1109 --   >    oShow circ
+ 1110 --   >    cameraAttach cam circ
+ 1111 --   >    cameraZoom cam 1 2
+ 1112 --   >    cameraZoom cam 1 1
+ 1113 --
+ 1114 --   <<docs/gifs/doc_cameraAttach.gif>>
+ 1115 cameraAttach :: Object s Camera -> Object s a -> Scene s ()
+ 1116 cameraAttach cam obj =
+ 1117   spriteModify (objectSprite obj) $ do
+ 1118     camData <- unVar (objectData cam)
+ 1119     return $ \(svg,zindex) ->
+ 1120       let (x,y) = camData^.oTranslate
+ 1121           ctx =
+ 1122             translate (-x) (-y) .
+ 1123             uncurry translate (camData^.oScaleOrigin) .
+ 1124             scale (camData^.oScale) .
+ 1125             uncurry translate (camData^.oScaleOrigin & both %~ negate)
+ 1126       in (ctx svg, zindex)
+ 1127 
+ 1128 -- |
+ 1129 --
+ 1130 --   Example
+ 1131 --
+ 1132 --   > do cam <- newObject Camera
+ 1133 --   >    circ <- newObject $ Circle 2; oShow circ
+ 1134 --   >    oModify circ $ oTranslate .~ (-3,0)
+ 1135 --   >    box <- newObject $ Rectangle 4 4; oShow box
+ 1136 --   >    oModify box $ oTranslate .~ (3,0)
+ 1137 --   >    cameraAttach cam circ
+ 1138 --   >    cameraAttach cam box
+ 1139 --   >    cameraFocus cam (-3,0)
+ 1140 --   >    cameraZoom cam 2 2      -- Zoom in
+ 1141 --   >    cameraZoom cam 2 1      -- Zoom out
+ 1142 --   >    cameraFocus cam (3,0)
+ 1143 --   >    cameraZoom cam 2 2      -- Zoom in
+ 1144 --   >    cameraZoom cam 2 1      -- Zoom out
+ 1145 --
+ 1146 --   <<docs/gifs/doc_cameraFocus.gif>>
+ 1147 cameraFocus :: Object s Camera -> (Double, Double) -> Scene s ()
+ 1148 cameraFocus cam (x,y) = do
+ 1149   (ox, oy) <- oRead cam oScaleOrigin
+ 1150   (tx, ty) <- oRead cam oTranslate
+ 1151   s <- oRead cam oScale
+ 1152   let newLocation = (x-((x-ox)*s+ox-tx), y-((y-oy)*s+oy-ty))
+ 1153   oModifyS cam $ do
+ 1154     oTranslate .= newLocation
+ 1155     oScaleOrigin .= (x,y)
+ 1156 
+ 1157 -- | Instantaneously set camera zoom level.
+ 1158 cameraSetZoom :: Object s Camera -> Double -> Scene s ()
+ 1159 cameraSetZoom cam s =
+ 1160   oModifyS cam $
+ 1161     oScale .= s
+ 1162 
+ 1163 -- | Change camera zoom level over a set duration.
+ 1164 cameraZoom :: Object s Camera -> Duration -> Double -> Scene s ()
+ 1165 cameraZoom cam d s =
+ 1166   oTweenS cam d $ \t ->
+ 1167     oScale %= \v -> fromToS v s t
+ 1168 
+ 1169 -- | Instantaneously set camera location.
+ 1170 cameraSetPan :: Object s Camera -> (Double, Double) -> Scene s ()
+ 1171 cameraSetPan cam location =
+ 1172   oModifyS cam $ do
+ 1173     oTranslate .= location
+ 1174 
+ 1175 -- | Change camera location over a set duration.
+ 1176 cameraPan :: Object s Camera -> Duration -> (Double, Double) -> Scene s ()
+ 1177 cameraPan cam d (x,y) =
+ 1178   oTweenS cam d $ \t -> do
+ 1179     oTranslate._1 %= \v -> fromToS v x t
+ 1180     oTranslate._2 %= \v -> fromToS v y t
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Svg.BoundingBox.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Svg.BoundingBox.hs.html new file mode 100644 index 0000000..143e939 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Svg.BoundingBox.hs.html @@ -0,0 +1,153 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-|
+    2   Bounding-boxes can be immensely useful for aligning objects
+    3   but they are not part of the SVG specification and cannot be
+    4   computed for all SVG nodes. In particular, you'll get bad results
+    5   when asking for the bounding boxes of Text nodes (because fonts
+    6   are difficult), clipped nodes, and filtered nodes.
+    7 -}
+    8 module Reanimate.Svg.BoundingBox
+    9   ( boundingBox
+   10   , svgHeight
+   11   , svgWidth
+   12   ) where
+   13 
+   14 import           Control.Arrow ((***))
+   15 import           Control.Lens ((^.))
+   16 import           Data.List
+   17 import           Data.Maybe (mapMaybe)
+   18 import qualified Data.Vector.Unboxed as V
+   19 import qualified Geom2D.CubicBezier.Linear as Bezier
+   20 import           Graphics.SvgTree hiding (height, line, path, use, width)
+   21 import           Linear.V2 hiding (angle)
+   22 import           Linear.Vector
+   23 import           Reanimate.Constants
+   24 import           Reanimate.Svg.LineCommand
+   25 import qualified Reanimate.Transform as Transform
+   26 
+   27 -- | Return bounding box of SVG tree.
+   28 --  The four numbers returned are (minimal X-coordinate, minimal Y-coordinate, width, height)
+   29 --
+   30 --  Note: Bounding boxes are computed on a best-effort basis and will not work
+   31 --        in all cases. The only supported SVG nodes are: path, circle, polyline,
+   32 --        ellipse, line, rectangle, image. All other nodes return (0,0,0,0).
+   33 boundingBox :: Tree -> (Double, Double, Double, Double)
+   34 boundingBox t =
+   35     case svgBoundingPoints t of
+   36       [] -> (0,0,0,0)
+   37       (V2 x y:rest) ->
+   38         let (minx, miny, maxx, maxy) = foldl' worker (x, y, x, y) rest
+   39         in (minx, miny, maxx-minx, maxy-miny)
+   40   where
+   41     worker (minx, miny, maxx, maxy) (V2 x y) =
+   42       (min minx x, min miny y, max maxx x, max maxy y)
+   43 
+   44 -- | Height of SVG node in local units (not pixels). Computed on best-effort basis
+   45 --   and will not give accurate results for all SVG nodes.
+   46 svgHeight :: Tree -> Double
+   47 svgHeight t = h
+   48   where
+   49     (_x, _y, _w, h) = boundingBox t
+   50 
+   51 -- | Width of SVG node in local units (not pixels). Computed on best-effort basis
+   52 --   and will not give accurate results for all SVG nodes.
+   53 svgWidth :: Tree -> Double
+   54 svgWidth t = w
+   55   where
+   56     (_x, _y, w, _h) = boundingBox t
+   57 
+   58 -- | Sampling of points in a line path.
+   59 linePoints :: [LineCommand] -> [RPoint]
+   60 linePoints = worker zero
+   61   where
+   62     worker _from [] = []
+   63     worker from (x:xs) =
+   64       case x of
+   65         LineMove to     -> worker to xs
+   66         -- LineDraw to     -> from:to:worker to xs
+   67         LineBezier [p] ->
+   68           p : worker p xs
+   69         LineBezier ctrl -> -- approximation
+   70           let bezier = Bezier.AnyBezier (V.fromList (from:ctrl))
+   71           in [ Bezier.evalBezier bezier (recip chunks*i) | i <- [0..chunks]] ++
+   72           worker (last ctrl) xs
+   73         LineEnd p -> p : worker p xs
+   74     chunks = 10
+   75 
+   76 svgBoundingPoints :: Tree -> [RPoint]
+   77 svgBoundingPoints t = map (Transform.transformPoint m) $
+   78     case t of
+   79       None            -> []
+   80       UseTree{}       -> []
+   81       GroupTree g     -> concatMap svgBoundingPoints (g^.groupChildren)
+   82       SymbolTree (Symbol g) -> concatMap svgBoundingPoints (g^.groupChildren)
+   83       FilterTree{}    -> []
+   84       DefinitionTree{} -> []
+   85       PathTree p      -> linePoints $ toLineCommands (p^.pathDefinition)
+   86       CircleTree c    -> circleBoundingPoints c
+   87       PolyLineTree pl -> pl ^. polyLinePoints
+   88       EllipseTree e   -> ellipseBoundingPoints e
+   89       LineTree line   -> map pointToRPoint [line^.linePoint1, line^.linePoint2]
+   90       RectangleTree rect ->
+   91         case pointToRPoint (rect^.rectUpperLeftCorner) of
+   92           V2 x y -> V2 x y :
+   93             case mapTuple (fmap $ toUserUnit defaultDPI) (rect^.rectWidth, rect^.rectHeight) of
+   94               (Just (Num w), Just (Num h)) -> [V2 (x+w) (y+h)]
+   95               _                            -> []
+   96       TextTree{}      -> []
+   97       ImageTree img   ->
+   98         case (img^.imageCornerUpperLeft, img^.imageWidth, img^.imageHeight) of
+   99           ((Num x, Num y), Num w, Num h) ->
+  100             [V2 x y, V2 (x+w) (y+h)]
+  101           _ -> []
+  102       MeshGradientTree{} -> []
+  103       _ -> []
+  104   where
+  105     m = Transform.mkMatrix (t^.transform)
+  106     mapTuple f = f *** f
+  107     pointToRPoint p =
+  108       case mapTuple (toUserUnit defaultDPI) p of
+  109         (Num x, Num y) -> V2 x y
+  110         _              -> error "Reanimate.Svg.svgBoundingPoints: Unrecognized number format."
+  111 
+  112     circleBoundingPoints circ =
+  113       let (xnum, ynum) = circ ^. circleCenter
+  114           rnum = circ ^. circleRadius
+  115       in case mapMaybe unpackNumber [xnum, ynum, rnum] of
+  116         [x, y, r] -> [ V2 (x + r * cos angle) (y + r * sin angle) | angle <- [0, pi/10 .. 2 * pi]]
+  117         _  -> []
+  118 
+  119     ellipseBoundingPoints e =
+  120       let (xnum,ynum) = e ^. ellipseCenter
+  121           xrnum = e ^. ellipseXRadius
+  122           yrnum = e ^. ellipseYRadius
+  123       in case mapMaybe unpackNumber [xnum, ynum, xrnum, yrnum] of
+  124         [x,y,xr,yr] -> [V2 (x + xr * cos angle) (y + yr * sin angle) | angle <- [0, pi/10 .. 2 * pi]]
+  125         _ -> []
+  126 
+  127     unpackNumber n =
+  128       case toUserUnit defaultDPI n of
+  129         Num d -> Just d
+  130         _     -> Nothing
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Svg.Constructors.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Svg.Constructors.hs.html new file mode 100644 index 0000000..5838236 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Svg.Constructors.hs.html @@ -0,0 +1,444 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-| Functions for creating basic SVG elements and applying transformations to them. -}
+    2 module Reanimate.Svg.Constructors
+    3   ( -- * Primitive shapes
+    4     mkCircle
+    5   , mkEllipse
+    6   , mkRect
+    7   , mkLine
+    8   , mkPath
+    9   , mkPathString
+   10   , mkPathText
+   11   , mkLinePath
+   12   , mkLinePathClosed
+   13   , mkClipPath
+   14   , mkText
+   15   -- * Grouping shapes and definitions
+   16   , mkGroup
+   17   , mkDefinitions
+   18   , mkUse
+   19   -- * Attributes
+   20   , withId
+   21   , withStrokeColor
+   22   , withStrokeColorPixel
+   23   , withStrokeDashArray
+   24   , withStrokeLineJoin
+   25   , withFillColor
+   26   , withFillColorPixel
+   27   , withFillOpacity
+   28   , withGroupOpacity
+   29   , withStrokeWidth
+   30   , withClipPathRef
+   31   -- * Transformations
+   32   , center
+   33   , centerX
+   34   , centerY
+   35   , centerUsing
+   36   , translate
+   37   , rotate
+   38   , rotateAroundCenter
+   39   , rotateAround
+   40   , scale
+   41   , scaleToSize
+   42   , scaleToWidth
+   43   , scaleToHeight
+   44   , scaleXY
+   45   , flipXAxis
+   46   , flipYAxis
+   47   , aroundCenter
+   48   , aroundCenterX
+   49   , aroundCenterY
+   50   , withTransformations
+   51   , withViewBox
+   52   -- * Other
+   53   , mkColor
+   54   , mkBackground
+   55   , mkBackgroundPixel
+   56   , gridLayout
+   57 
+   58   ) where
+   59 
+   60 import           Codec.Picture                (PixelRGBA8 (..))
+   61 import           Control.Lens                 ((&), (.~), (?~))
+   62 import           Data.Attoparsec.Text         (parseOnly)
+   63 import qualified Data.Map                     as Map
+   64 import qualified Data.Text                    as T
+   65 import           Graphics.SvgTree             hiding (height, line, path, use,
+   66                                                width)
+   67 import           Graphics.SvgTree.NamedColors
+   68 import           Graphics.SvgTree.PathParser
+   69 import           Linear.V2                    hiding (angle)
+   70 import           Reanimate.Constants
+   71 import           Reanimate.Svg.BoundingBox
+   72 
+   73 -- | Apply list of transformations to given image.
+   74 withTransformations :: [Transformation] -> Tree -> Tree
+   75 withTransformations transformations t =
+   76   mkGroup [t] & transform ?~ transformations
+   77 
+   78 -- | @translate x y image@ moves the @image@ by @x@ along X-axis and by @y@ along Y-axis.
+   79 translate :: Double -> Double -> Tree -> Tree
+   80 translate x y = withTransformations [Translate x y]
+   81 
+   82 -- | @rotate angle image@ rotates the @image@ around origin @(0,0)@ counterclockwise by @angle@
+   83 --   given in degrees.
+   84 rotate :: Double -> Tree -> Tree
+   85 rotate a = withTransformations [Rotate a Nothing]
+   86 
+   87 -- | @rotate angle point image@ rotates the @image@ around given @point@ counterclockwise by
+   88 --   @angle@ given in degrees.
+   89 rotateAround :: Double -> RPoint -> Tree -> Tree
+   90 rotateAround a (V2 x y) = withTransformations [Rotate a (Just (x,y))]
+   91 
+   92 -- | @rotate angle image@ rotates the @image@ around the center of its bounding box counterclockwise
+   93 --   by @angle@ given in degrees.
+   94 rotateAroundCenter :: Double -> Tree -> Tree
+   95 rotateAroundCenter a t =
+   96     rotateAround a (V2 (x+w/2) (y+h/2)) t
+   97   where
+   98     (x,y,w,h) = boundingBox t
+   99 
+  100 -- | @aroundCenter f image@ first moves the image so the center of its bounding box is at the origin
+  101 --   @(0, 0)@, applies transformation @f@ to it and then moves the transformed image back to its
+  102 --   original position.
+  103 aroundCenter :: (Tree -> Tree) -> Tree -> Tree
+  104 aroundCenter fn t =
+  105     translate (-offsetX) (-offsetY) $ fn $ translate offsetX offsetY t
+  106   where
+  107     offsetX = -x-w/2
+  108     offsetY = -y-h/2
+  109     (x,y,w,h) = boundingBox t
+  110 
+  111 -- | Same as 'aroundCenter' but only for the Y-axis.
+  112 aroundCenterY :: (Tree -> Tree) -> Tree -> Tree
+  113 aroundCenterY fn t =
+  114     translate 0 (-offsetY) $ fn $ translate 0 offsetY t
+  115   where
+  116     offsetY = -y-h/2
+  117     (_x,y,_w,h) = boundingBox t
+  118 
+  119 -- | Same as 'aroundCenter' but only for the X-axis.
+  120 aroundCenterX :: (Tree -> Tree) -> Tree -> Tree
+  121 aroundCenterX fn t =
+  122     translate (-offsetX) 0 $ fn $ translate offsetX 0 t
+  123   where
+  124     offsetX = -x-w/2
+  125     (x,_y,w,_h) = boundingBox t
+  126 
+  127 -- | Scale the image uniformly by given factor along both X and Y axes.
+  128 -- For example @scale 2 image@  makes the image twice as large, while @scale 0.5 image@ makes it
+  129 -- half the original size. Negative values are also allowed, and lead to flipping the image along
+  130 -- both X and Y axes.
+  131 scale :: Double -> Tree -> Tree
+  132 scale a = withTransformations [Scale a Nothing]
+  133 
+  134 -- | @scaleToSize width height@ resizes the image so that its bounding box has corresponding @width@
+  135 --   and @height@.
+  136 scaleToSize :: Double -> Double -> Tree -> Tree
+  137 scaleToSize w h t =
+  138     scaleXY (w/w') (h/h') t
+  139   where
+  140     (_x, _y, w', h') = boundingBox t
+  141 
+  142 -- | @scaleToWidth width@ scales the image so that the width of its bounding box ends up having
+  143 --   given @width@.
+  144 scaleToWidth :: Double -> Tree -> Tree
+  145 scaleToWidth w t =
+  146     scale (w/w') t
+  147   where
+  148     (_x, _y, w', _h') = boundingBox t
+  149 
+  150 -- | @scaleToHeight height@ scales the image so that the height of its bounding box ends up having
+  151 --   given @height@.
+  152 scaleToHeight :: Double -> Tree -> Tree
+  153 scaleToHeight h t =
+  154     scale (h/h') t
+  155   where
+  156     (_x, _y, _w', h') = boundingBox t
+  157 
+  158 -- | Similar to 'scale', except scale factors for X and Y axes are specified separately.
+  159 scaleXY :: Double -> Double -> Tree -> Tree
+  160 scaleXY x y = withTransformations [Scale x (Just y)]
+  161 
+  162 
+  163 -- | Flip the image along vertical axis so that what was on the right will end up on left and vice
+  164 --   versa.
+  165 flipXAxis :: Tree -> Tree
+  166 flipXAxis = scaleXY (-1) 1
+  167 
+  168 -- | Flip the image along horizontal so that what was on the top will end up in the bottom and vice
+  169 --   versa.
+  170 flipYAxis :: Tree -> Tree
+  171 flipYAxis = scaleXY 1 (-1)
+  172 
+  173 -- | Translate given image so that the center of its bouding box coincides with coordinates
+  174 --   @(0, 0)@.
+  175 center :: Tree -> Tree
+  176 center t = centerUsing t t
+  177 
+  178 -- | Translate given image so that the X-coordinate of the center of its bouding box is 0.
+  179 centerX :: Tree -> Tree
+  180 centerX t = translate (-x-w/2) 0 t
+  181   where
+  182     (x, _y, w, _h) = boundingBox t
+  183 
+  184 -- | Translate given image so that the Y-coordinate of the center of its bouding box is 0.
+  185 centerY :: Tree -> Tree
+  186 centerY t = translate 0 (-y-h/2) t
+  187   where
+  188     (_x, y, _w, h) = boundingBox t
+  189 
+  190 -- | Center the second argument using the bounding-box of the first.
+  191 centerUsing :: Tree -> Tree -> Tree
+  192 centerUsing a = translate (-x-w/2) (-y-h/2)
+  193   where
+  194     (x, y, w, h) = boundingBox a
+  195 
+  196 -- | Create 'Texture' based on SVG color name.
+  197 --   See <https://en.wikipedia.org/wiki/Web_colors#X11_color_names> for the list of available names.
+  198 --   If the provided name doesn't correspond to valid SVG color name, white-ish color is used.
+  199 mkColor :: String -> Texture
+  200 mkColor name =
+  201   case Map.lookup (T.pack name) svgNamedColors of
+  202     Nothing -> ColorRef (PixelRGBA8 240 248 255 255)
+  203     Just c  -> ColorRef c
+  204 
+  205 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>
+  206 withStrokeColor :: String -> Tree -> Tree
+  207 withStrokeColor color = strokeColor .~ pure (mkColor color)
+  208 
+  209 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>
+  210 withStrokeColorPixel :: PixelRGBA8 -> Tree -> Tree
+  211 withStrokeColorPixel color = strokeColor .~ pure (ColorRef color)
+  212 
+  213 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-dasharray>
+  214 withStrokeDashArray :: [Double] -> Tree -> Tree
+  215 withStrokeDashArray arr = strokeDashArray .~ pure (map Num arr)
+  216 
+  217 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-linejoin>
+  218 withStrokeLineJoin :: LineJoin -> Tree -> Tree
+  219 withStrokeLineJoin ljoin = strokeLineJoin .~ pure ljoin
+  220 
+  221 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>
+  222 withFillColor :: String -> Tree -> Tree
+  223 withFillColor color = fillColor .~ pure (mkColor color)
+  224 
+  225 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>
+  226 withFillColorPixel :: PixelRGBA8 -> Tree -> Tree
+  227 withFillColorPixel color = fillColor .~ pure (ColorRef color)
+  228 
+  229 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill-opacity>
+  230 withFillOpacity :: Double -> Tree -> Tree
+  231 withFillOpacity opacity = fillOpacity ?~ realToFrac opacity
+  232 
+  233 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/opacity>
+  234 withGroupOpacity :: Double -> Tree -> Tree
+  235 withGroupOpacity opacity = groupOpacity ?~ realToFrac opacity
+  236 
+  237 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-width>
+  238 withStrokeWidth :: Double -> Tree -> Tree
+  239 withStrokeWidth width = strokeWidth .~ pure (Num width)
+  240 
+  241 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/clip-path>
+  242 withClipPathRef :: ElementRef -- ^ Reference to clip path defined previously (e.g. by 'mkClipPath')
+  243                 -> Tree -- ^ Image that will be clipped by the referenced clip path
+  244                 -> Tree
+  245 withClipPathRef ref sub = mkGroup [sub] & clipPathRef .~ pure ref
+  246 
+  247 -- | Assigns ID attribute to given image.
+  248 withId :: String -> Tree -> Tree
+  249 withId idTag = attrId ?~ idTag
+  250 
+  251 -- | @mkRect width height@ creates a rectangle with given @with@ and @height@, centered at @(0, 0)@.
+  252 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/rect>
+  253 mkRect :: Double -> Double -> Tree
+  254 mkRect width height = translate (-width/2) (-height/2) $ RectangleTree $ defaultSvg
+  255   & rectUpperLeftCorner .~ (Num 0, Num 0)
+  256   & rectWidth ?~ Num width
+  257   & rectHeight ?~ Num height
+  258 
+  259 -- | Create a circle with given radius, centered at @(0, 0)@.
+  260 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/circle>
+  261 mkCircle :: Double -> Tree
+  262 mkCircle radius = CircleTree $ defaultSvg
+  263   & circleCenter .~ (Num 0, Num 0)
+  264   & circleRadius .~ Num radius
+  265 
+  266 -- | Create an ellipse given X-axis radius, and Y-axis radius, with center at @(0, 0)@.
+  267 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/ellipse>
+  268 mkEllipse :: Double -> Double -> Tree
+  269 mkEllipse rx ry = EllipseTree $ defaultSvg
+  270   & ellipseCenter .~ (Num 0, Num 0)
+  271   & ellipseXRadius .~ Num rx
+  272   & ellipseYRadius .~ Num ry
+  273 
+  274 -- | Create a line segment between two points given by their @(x, y)@ coordinates.
+  275 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/line>
+  276 mkLine :: (Double,Double) -> (Double, Double) -> Tree
+  277 mkLine (x1,y1) (x2,y2) = LineTree $ defaultSvg
+  278   & linePoint1 .~ (Num x1, Num y1)
+  279   & linePoint2 .~ (Num x2, Num y2)
+  280 
+  281 -- | Merges multiple images into one.
+  282 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/g>
+  283 mkGroup :: [Tree] -> Tree
+  284 mkGroup forest = GroupTree $ defaultSvg
+  285   & groupChildren .~ forest
+  286 
+  287 -- | Create definition of graphical objects that can be used at later time.
+  288 --   See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/defs>
+  289 mkDefinitions :: [Tree] -> Tree
+  290 mkDefinitions forest = DefinitionTree $ defaultSvg
+  291   & groupChildren .~ forest
+  292 
+  293 -- | Create an element by referring to existing element defined previously.
+  294 -- For example you can create a graphical element, assign ID to it using 'withId', wrap it in
+  295 -- 'mkDefinitions' and then use it via @use "myId"@.
+  296 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/use>
+  297 mkUse :: String -> Tree
+  298 mkUse name = UseTree (defaultSvg & useName .~ name) Nothing
+  299 
+  300 -- | A clip path restricts the region to which paint can be applied.
+  301 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/clipPath>
+  302 mkClipPath :: String  -- ^ ID of the clip path, which can then be referred to by other elements
+  303                       --   using 'withClipPathRef'.
+  304            -> [Tree] -- ^ List of shapes that will determine the final shape of the clipping region
+  305            -> Tree
+  306 mkClipPath idTag forest = withId idTag $ ClipPathTree $ defaultSvg
+  307   & clipPathContent .~ forest
+  308 
+  309 -- | Create a path from the list of path commands.
+  310 --   See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d#Path_commands>
+  311 mkPath :: [PathCommand] -> Tree
+  312 mkPath cmds = PathTree $ defaultSvg & pathDefinition .~ cmds
+  313 
+  314 -- | Similar to 'mkPathText', but taking SVG path command as a String.
+  315 mkPathString :: String -> Tree
+  316 mkPathString = mkPathText . T.pack
+  317 
+  318 -- | Create path from textual representation of SVG path command.
+  319 --   If the text doesn't represent valid path command, this function fails with 'Prelude.error'.
+  320 --   Use 'mkPath' for type safe way of creating paths.
+  321 mkPathText :: T.Text -> Tree
+  322 mkPathText str =
+  323   case parseOnly pathParser str of
+  324     Left err   -> error err
+  325     Right cmds -> mkPath cmds
+  326 
+  327 -- | Create a path from a list of @(x, y)@ coordinates of points along the path.
+  328 mkLinePath :: [(Double, Double)] -> Tree
+  329 mkLinePath [] = mkGroup []
+  330 mkLinePath ((startX, startY):rest) =
+  331     PathTree $ defaultSvg & pathDefinition .~ cmds
+  332   where
+  333     cmds = [ MoveTo OriginAbsolute [V2 startX startY]
+  334            , LineTo OriginAbsolute [ V2 x y | (x, y) <- rest ] ]
+  335 
+  336 -- | Create a path from a list of @(x, y)@ coordinates of points along the path.
+  337 mkLinePathClosed :: [(Double, Double)] -> Tree
+  338 mkLinePathClosed [] = mkGroup []
+  339 mkLinePathClosed ((startX, startY):rest) =
+  340     PathTree $ defaultSvg & pathDefinition .~ cmds
+  341   where
+  342     cmds = [ MoveTo OriginAbsolute [V2 startX startY]
+  343            , LineTo OriginAbsolute [ V2 x y | (x, y) <- rest ]
+  344            , EndPath ]
+  345 
+  346 -- | Rectangle with a uniform color and the same size as the screen.
+  347 --
+  348 --   Example:
+  349 --
+  350 --   > animate $ const $ mkBackground "yellow"
+  351 --
+  352 --   <<docs/gifs/doc_mkBackground.gif>>
+  353 mkBackground :: String -> Tree
+  354 mkBackground color = withFillOpacity 1 $  withStrokeWidth 0 $
+  355   withFillColor color $ mkRect screenWidth screenHeight
+  356 
+  357 -- | Rectangle with a uniform color and the same size as the screen.
+  358 mkBackgroundPixel :: PixelRGBA8 -> Tree
+  359 mkBackgroundPixel pixel =
+  360     withFillOpacity 1 $ withStrokeWidth 0 $
+  361     withFillColorPixel pixel $ mkRect screenWidth screenHeight
+  362 
+  363 -- | Take list of rows, where each row consists of number of images and display them in regular
+  364 --   grid structure.
+  365 --   All rows will get equal amount of vertical space.
+  366 --   The images within each row will get equal amount of horizontal space, independent of the other
+  367 --   rows. Each row can contain different number of cells.
+  368 gridLayout :: [[Tree]] -> Tree
+  369 gridLayout rows = mkGroup
+  370     [ translate (-screenWidth/2+colSep*nCol + colSep*0.5)
+  371                 (screenHeight/2-rowSep*nRow - rowSep*0.5)
+  372       elt
+  373     | (nRow, row) <- zip [0..] rows
+  374     , let nCols = length row
+  375           colSep = screenWidth / fromIntegral nCols
+  376     , (nCol, elt) <- zip [0..] row ]
+  377   where
+  378     rowSep = screenHeight / fromIntegral nRows
+  379     nRows = length rows
+  380 
+  381 -- | Insert a native text object anchored at the middle.
+  382 --
+  383 --   Example:
+  384 --
+  385 --   > mkAnimation 2 $ \t -> scale 2 $ withStrokeWidth 0.05 $ mkText (T.take (round $ t*15) "text")
+  386 --
+  387 --   <<docs/gifs/doc_mkText.gif>>
+  388 mkText :: T.Text -> Tree
+  389 mkText str =
+  390   flipYAxis
+  391   (TextTree Nothing $ defaultSvg
+  392     & textRoot .~ span_
+  393     & fontSize .~ pure (Num 2))
+  394     & textAnchor .~ pure TextAnchorMiddle
+  395     -- Note: TextAnchorMiddle is placed on the 'flipYAxis' group such that it can easily
+  396     -- be overwritten by the user.
+  397   where
+  398     span_ = defaultSvg & spanContent .~ [SpanText str]
+  399 
+  400 -- | Switch from the default viewbox to a custom viewbox. Nesting custom viewboxes is
+  401 --   unlikely to give good results. If you need nested custom viewboxes, you will have
+  402 --   to configure them by hand.
+  403 --
+  404 --   The viewbox argument is (min-x, min-y, width, height).
+  405 --
+  406 --   Example:
+  407 --
+  408 --   > withViewBox (0,0,1,1) $ mkBackground "yellow"
+  409 --
+  410 --   <<docs/gifs/doc_withViewBox.gif>>
+  411 withViewBox :: (Double, Double, Double, Double) -> Tree -> Tree
+  412 withViewBox vbox child = translate (-screenWidth/2) (-screenHeight/2) $
+  413   SvgTree $ Document
+  414   { _viewBox = Just vbox
+  415   , _width = Just (Num screenWidth)
+  416   , _height = Just (Num screenHeight)
+  417   , _elements = [child]
+  418   , _description = ""
+  419   , _documentLocation = ""
+  420   , _documentAspectRatio = PreserveAspectRatio False AlignNone Nothing
+  421   }
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Svg.LineCommand.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Svg.LineCommand.hs.html new file mode 100644 index 0000000..2a51f7c --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Svg.LineCommand.hs.html @@ -0,0 +1,302 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-|
+    2 Copyright   : Written by David Himmelstrup
+    3 License     : Unlicense
+    4 Maintainer  : lemmih@gmail.com
+    5 Stability   : experimental
+    6 Portability : POSIX
+    7 -}
+    8 module Reanimate.Svg.LineCommand
+    9   ( CmdM
+   10   , LineCommand(..)
+   11   , lineLength
+   12   , toLineCommands
+   13   , lineToPath
+   14   , lineToPoints
+   15   , partialSvg
+   16   ) where
+   17 
+   18 import           Control.Lens              ((%~), (&), (.~))
+   19 import           Control.Monad.Fix
+   20 import           Control.Monad.State
+   21 import           Data.Functor
+   22 import qualified Data.Vector.Unboxed       as V
+   23 import qualified Geom2D.CubicBezier.Linear as Bezier
+   24 import           Graphics.SvgTree          hiding (height, line, path, use, width)
+   25 import           Linear.Metric
+   26 import           Linear.V2                 hiding (angle)
+   27 import           Linear.Vector
+   28 
+   29 -- | Line command monad used for keeping track of the current location.
+   30 type CmdM a = State RPoint a
+   31 
+   32 -- | Simplified version of a PathCommand where all points are absolute.
+   33 data LineCommand
+   34   = LineMove RPoint
+   35   -- | LineDraw RPoint
+   36   | LineBezier [RPoint]
+   37   | LineEnd RPoint
+   38   deriving (Show)
+   39 
+   40 -- | Convert from line commands to path commands.
+   41 lineToPath :: [LineCommand] -> [PathCommand]
+   42 lineToPath = map worker
+   43   where
+   44     worker (LineMove p)         = MoveTo OriginAbsolute [p]
+   45     -- worker (LineDraw p)         = LineTo OriginAbsolute [p]
+   46     worker (LineBezier [a,b,c]) = CurveTo OriginAbsolute [(a,b,c)]
+   47     worker (LineBezier [a,b])   = QuadraticBezier OriginAbsolute [(a,b)]
+   48     worker (LineBezier [a])     = LineTo OriginAbsolute [a]
+   49     worker LineBezier{}         = error "Reanimate.Svg.lineToPath: invalid bezier curve"
+   50     worker LineEnd{}            = EndPath
+   51 
+   52 -- | Using @n@ control points, approximate the path of the curves.
+   53 lineToPoints :: Int -> [LineCommand] -> [RPoint]
+   54 lineToPoints nPoints cmds =
+   55     map lineEnd lineSegments
+   56   where
+   57     lineSegments = [ partialLine (fromIntegral n/ fromIntegral nPoints) cmds | n <- [0 .. nPoints-1] ]
+   58     lineEnd [LineBezier pts] = last pts
+   59     lineEnd (_:xs)           = lineEnd xs
+   60     lineEnd _                = error "invalid line"
+   61 
+   62 partialLine :: Double -> [LineCommand] -> [LineCommand]
+   63 partialLine alpha cmds = evalState (worker 0 cmds) zero
+   64   where
+   65     worker _d [] = pure []
+   66     worker d (cmd:xs) = do
+   67       from <- get
+   68       len <- lineLength cmd
+   69       let frac = (targetLen-d) / len
+   70       if len == 0 || frac >= 1
+   71         then (cmd:) <$> worker (d+len) xs
+   72         else pure [adjustLineLength frac from cmd]
+   73     totalLen = evalState (sum <$> mapM lineLength cmds) zero
+   74     targetLen = totalLen * alpha
+   75 
+   76 adjustLineLength :: Double -> RPoint -> LineCommand -> LineCommand
+   77 adjustLineLength alpha from cmd =
+   78   case cmd of
+   79     LineBezier points -> LineBezier $ drop 1 $ partialBezierPoints (from:points) 0 alpha
+   80     LineMove p        -> LineMove p
+   81     -- LineDraw t -> LineDraw (lerp alpha t from)
+   82     LineEnd p         -> LineBezier [lerp alpha p from]
+   83 
+   84 -- | Estimated length of all segments in a line.
+   85 lineLength :: LineCommand -> CmdM Double
+   86 lineLength cmd =
+   87   case cmd of
+   88     LineMove to       -> 0 <$ put to
+   89     -- Straight line:
+   90     LineBezier [dst] -> gets (distance dst) <* put dst
+   91     -- Some kind of curve:
+   92     LineBezier lst -> do
+   93       from <- get
+   94       let bezier = rpointsToBezier (from:lst)
+   95           tol = 0.0001
+   96       put (last lst)
+   97       pure $ Bezier.arcLength bezier 1 tol
+   98     LineEnd to        -> gets (distance to) <* put to
+   99 
+  100 rpointsToBezier :: [RPoint] -> Bezier.CubicBezier Double
+  101 rpointsToBezier lst =
+  102   case lst of
+  103     [a,b]     -> Bezier.CubicBezier a a b b
+  104     [a,b,c]   -> Bezier.quadToCubic (Bezier.QuadBezier a b c)
+  105     [a,b,c,d] -> Bezier.CubicBezier a b c d
+  106     _         -> error $ "rpointsToBezier: Invalid list of points: " ++ show lst
+  107 
+  108 -- | Convert from path commands to line commands.
+  109 toLineCommands :: [PathCommand] -> [LineCommand]
+  110 toLineCommands ps = evalState (worker zero Nothing ps) zero
+  111   where
+  112     worker _startPos _mbPrevControlPt [] = pure []
+  113     worker startPos mbPrevControlPt (cmd:cmds) = do
+  114       lcmds <- toLineCommand startPos mbPrevControlPt cmd
+  115       let startPos' =
+  116             case lcmds of
+  117               [LineMove pos] -> pos
+  118               _              -> startPos
+  119       (lcmds++) <$> worker startPos' (cmdToControlPoint $ last lcmds) cmds
+  120 
+  121 cmdToControlPoint :: LineCommand -> Maybe RPoint
+  122 cmdToControlPoint (LineBezier points) = Just (last (init points))
+  123 cmdToControlPoint _                   = Nothing
+  124 
+  125 mkStraightLine :: RPoint -> LineCommand
+  126 mkStraightLine p = LineBezier [p]
+  127 
+  128 toLineCommand :: RPoint -> Maybe RPoint -> PathCommand -> CmdM [LineCommand]
+  129 toLineCommand startPos mbPrevControlPt cmd =
+  130   case cmd of
+  131     MoveTo OriginAbsolute []  -> pure []
+  132     MoveTo OriginAbsolute lst -> put (last lst) *> gets (pure.LineMove)
+  133     MoveTo OriginRelative lst -> modify (+ sum lst) *> gets (pure.LineMove)
+  134     LineTo OriginAbsolute lst -> forM lst (\to -> put to $> mkStraightLine to)
+  135     LineTo OriginRelative lst -> forM lst (\to -> modify (+to) *> gets mkStraightLine)
+  136     HorizontalTo OriginAbsolute lst ->
+  137       forM lst $ \x -> modify (_x .~ x) *> gets mkStraightLine
+  138     HorizontalTo OriginRelative lst ->
+  139       forM lst $ \x -> modify (_x %~ (+x)) *> gets mkStraightLine
+  140     VerticalTo OriginAbsolute lst ->
+  141       forM lst $ \y -> modify (_y .~ y) *> gets mkStraightLine
+  142     VerticalTo OriginRelative lst ->
+  143       forM lst $ \y -> modify (_y %~ (+y)) *> gets mkStraightLine
+  144     CurveTo OriginAbsolute quads ->
+  145       forM quads $ \(a,b,c) -> put c $> LineBezier [a,b,c]
+  146     CurveTo OriginRelative quads ->
+  147       forM quads $ \(a,b,c) -> do
+  148         from <- get <* modify (+c)
+  149         pure $ LineBezier $ map (+from) [a,b,c]
+  150     SmoothCurveTo o lst -> mfix $ \result -> do
+  151       let ctrl = mbPrevControlPt : map cmdToControlPoint result
+  152       forM (zip lst ctrl) $ \((c2,to), mbControl) -> do
+  153         from <- get <* adjustPosition o to
+  154         let c1 = maybe (makeAbsolute o from c2) (mirrorPoint from) mbControl
+  155         pure $ LineBezier [c1,makeAbsolute o from c2,makeAbsolute o from to]
+  156     QuadraticBezier OriginAbsolute pairs ->
+  157       forM pairs $ \(a,b) -> put b $> LineBezier [a,b]
+  158     QuadraticBezier OriginRelative pairs ->
+  159       forM pairs $ \(a,b) -> do
+  160         from <- get <* modify (+b)
+  161         pure $ LineBezier $ map (+from) [a,b]
+  162     SmoothQuadraticBezierCurveTo o lst -> mfix $ \result -> do
+  163       let ctrl = mbPrevControlPt : map cmdToControlPoint result
+  164       forM (zip lst ctrl) $ \(to, mbControl) -> do
+  165         from <- get <* adjustPosition o to
+  166         let c1 = maybe from (mirrorPoint from) mbControl
+  167         pure $ LineBezier [c1,makeAbsolute o from to]
+  168     EllipticalArc o points -> concat <$>
+  169       forM points (\(rotX, rotY, angle, largeArc, sweepFlag, to) -> do
+  170         from <- get <* adjustPosition o to
+  171         return $ convertSvgArc from rotX rotY angle largeArc sweepFlag (makeAbsolute o from to))
+  172     EndPath -> put startPos $> [LineEnd startPos]
+  173   where
+  174     mirrorPoint c p = c*2-p
+  175     adjustPosition OriginRelative p = modify (+p)
+  176     adjustPosition OriginAbsolute p = put p
+  177     makeAbsolute OriginAbsolute _from p = p
+  178     makeAbsolute OriginRelative from p  = from+p
+  179 
+  180 
+  181 calculateVectorAngle :: Double -> Double -> Double -> Double -> Double
+  182 calculateVectorAngle ux uy vx vy
+  183     | tb >= ta
+  184         = tb - ta
+  185     | otherwise
+  186         = pi * 2 - (ta - tb)
+  187     where
+  188         ta = atan2 uy ux
+  189         tb = atan2 vy vx
+  190 
+  191 -- ported from: https://github.com/vvvv/SVG/blob/master/Source/Paths/SvgArcSegment.cs
+  192 {- HLINT ignore convertSvgArc -}
+  193 convertSvgArc :: RPoint -> Coord -> Coord -> Coord -> Bool -> Bool -> RPoint -> [LineCommand]
+  194 convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)
+  195     | x0 == x && y0 == y
+  196         = []
+  197     | radiusX == 0.0 && radiusY == 0.0
+  198         = [LineBezier [V2 x y]]
+  199     | otherwise
+  200         = calcSegments x0 y0 theta1' segments'
+  201     where
+  202         sinPhi = sin (angle * pi/180)
+  203         cosPhi = cos (angle * pi/180)
+  204 
+  205         x1dash = cosPhi * (x0 - x) / 2.0 + sinPhi * (y0 - y) / 2.0
+  206         y1dash = -sinPhi * (x0 - x) / 2.0 + cosPhi * (y0 - y) / 2.0
+  207 
+  208         numerator = radiusX * radiusX * radiusY * radiusY - radiusX * radiusX * y1dash * y1dash - radiusY * radiusY * x1dash * x1dash
+  209 
+  210         s = sqrt(1.0 - numerator / (radiusX * radiusX * radiusY * radiusY))
+  211         rx   = if (numerator < 0.0) then (radiusX * s) else radiusX
+  212         ry   = if (numerator < 0.0) then (radiusY * s) else radiusY
+  213         root = if (numerator < 0.0)
+  214                 then (0.0)
+  215                 else ((if ((largeArcFlag && sweepFlag) || (not largeArcFlag && not sweepFlag)) then (-1.0) else 1.0) *
+  216                         sqrt(numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash)))
+  217 
+  218         cxdash = root * rx * y1dash / ry
+  219         cydash = -root * ry * x1dash / rx
+  220 
+  221         cx = cosPhi * cxdash - sinPhi * cydash + (x0 + x) / 2.0
+  222         cy = sinPhi * cxdash + cosPhi * cydash + (y0 + y) / 2.0
+  223 
+  224         theta1'  = calculateVectorAngle 1.0 0.0 ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry)
+  225         dtheta' = calculateVectorAngle ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry) ((-x1dash - cxdash) / rx) ((-y1dash - cydash) / ry)
+  226         dtheta  = if (not sweepFlag && dtheta' > 0)
+  227                     then  (dtheta' - 2 * pi)
+  228                     else  (if (sweepFlag && dtheta' < 0) then dtheta' + 2 * pi else dtheta')
+  229 
+  230         segments' = ceiling (abs (dtheta / (pi / 2.0)))
+  231         delta = dtheta / fromInteger segments'
+  232         t = 8.0 / 3.0 * sin(delta / 4.0) * sin(delta / 4.0) / sin(delta / 2.0)
+  233 
+  234         calcSegments startX startY theta1 segments
+  235             | segments == 0
+  236                 = []
+  237             | otherwise
+  238                 = LineBezier [ V2 (startX + dx1) (startY + dy1)
+  239                              , V2 (endpointX + dxe) (endpointY + dye)
+  240                              , V2 endpointX endpointY ] : calcSegments endpointX endpointY theta2 (segments - 1)
+  241             where
+  242                 cosTheta1 = cos theta1
+  243                 sinTheta1 = sin theta1
+  244                 theta2 = theta1 + delta
+  245                 cosTheta2 = cos theta2
+  246                 sinTheta2 = sin theta2
+  247 
+  248                 endpointX = cosPhi * rx * cosTheta2 - sinPhi * ry * sinTheta2 + cx
+  249                 endpointY = sinPhi * rx * cosTheta2 + cosPhi * ry * sinTheta2 + cy
+  250 
+  251                 dx1 = t * (-cosPhi * rx * sinTheta1 - sinPhi * ry * cosTheta1)
+  252                 dy1 = t * (-sinPhi * rx * sinTheta1 + cosPhi * ry * cosTheta1)
+  253 
+  254                 dxe = t * (cosPhi * rx * sinTheta2 + sinPhi * ry * cosTheta2)
+  255                 dye = t * (sinPhi * rx * sinTheta2 - cosPhi * ry * cosTheta2)
+  256 
+  257 partialBezierPoints :: [RPoint] -> Double -> Double -> [RPoint]
+  258 partialBezierPoints ps a b =
+  259   let c1 = Bezier.AnyBezier (V.fromList ps)
+  260       Bezier.AnyBezier os = Bezier.bezierSubsegment c1 a b
+  261   in V.toList os
+  262 
+  263 {- | Create an image showing portion of a path.
+  264      Note that this only affects paths (see 'Reanimate.Svg.Constructors.mkPath').
+  265      You can also use this with other SVG shapes if you convert them to path first (see 'Reanimate.Svg.pathify').
+  266 
+  267      Typical usage:
+  268 
+  269     > animate $ \t -> partialSvg t myPath
+  270 -}
+  271 partialSvg :: Double -- ^ number between 0 and 1 inclusively, determining what portion of the path to show
+  272            -> Tree -- ^ Image representing a path, of which we only want to display a portion determined by the first argument
+  273            -> Tree
+  274 partialSvg alpha | alpha >= 1 = id
+  275 partialSvg alpha = mapTree worker
+  276   where
+  277     worker (PathTree path) =
+  278       PathTree $ path & pathDefinition %~ lineToPath . partialLine alpha . toLineCommands
+  279     worker t = t
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Svg.Unuse.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Svg.Unuse.hs.html new file mode 100644 index 0000000..c4c1daf --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Svg.Unuse.hs.html @@ -0,0 +1,93 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-|
+    2 Copyright   : Written by David Himmelstrup
+    3 License     : Unlicense
+    4 Maintainer  : lemmih@gmail.com
+    5 Stability   : experimental
+    6 Portability : POSIX
+    7 -}
+    8 module Reanimate.Svg.Unuse
+    9   ( replaceUses
+   10   , unbox
+   11   , embedDocument
+   12   ) where
+   13 
+   14 import           Control.Lens               ((%~), (&), (.~), (?~), (^.))
+   15 import qualified Data.Map                   as Map
+   16 import           Data.Maybe
+   17 import           Graphics.SvgTree           hiding (line, path, use)
+   18 import           Reanimate.Constants
+   19 import           Reanimate.Svg.Constructors
+   20 
+   21 -- | Replace all @<use>@ nodes with their definition.
+   22 replaceUses :: Document -> Document
+   23 replaceUses doc = doc & elements %~ map (mapTree replace)
+   24   where
+   25     replaceDefinition PathTree{} = None
+   26     replaceDefinition t          = t
+   27 
+   28     replace t@DefinitionTree{} = mapTree replaceDefinition t
+   29     replace (UseTree _ Just{}) = error "replaceUses: subtree in use?"
+   30     replace (UseTree use Nothing) =
+   31       case Map.lookup (use^.useName) idMap of
+   32         Nothing -> error $ "Unknown id: " ++ (use^.useName)
+   33         Just tree -> mapTree replace $
+   34           GroupTree $
+   35           defaultSvg & groupChildren .~ [tree]
+   36                      & transform ?~
+   37                         fromMaybe [] (use^.transform) ++
+   38                         [baseToTransformation (use^.useBase)]
+   39     replace x = x
+   40     baseToTransformation (x,y) =
+   41       case (toUserUnit defaultDPI x, toUserUnit defaultDPI y) of
+   42         (Num a, Num b) -> Translate a b
+   43         _              -> TransformUnknown
+   44     docTree = mkGroup (doc^.elements)
+   45     idMap = foldTree updMap Map.empty docTree
+   46     updMap m tree =
+   47       case tree^.attrId of
+   48         Nothing  -> m
+   49         Just tid -> Map.insert tid tree m
+   50 
+   51 -- FIXME: the viewbox is ignored. Can we use the viewbox as a mask?
+   52 -- | Transform out viewbox. Definitions and CSS rules are discarded.
+   53 unbox :: Document -> Tree
+   54 unbox doc@Document{_viewBox = Just (_minx, _minw, _width, _height)} =
+   55   GroupTree $ defaultSvg
+   56           & groupChildren .~ doc^.elements
+   57 unbox doc =
+   58   GroupTree $ defaultSvg
+   59     & groupChildren .~ doc^.elements
+   60 
+   61 -- | Embed 'Document'. This keeps the entire document intact but makes
+   62 --   it more difficult to use, say, `Reanimate.Svg.pathify` on it.
+   63 embedDocument :: Document -> Tree
+   64 embedDocument doc =
+   65   translate (-screenWidth/2) (screenHeight/2) $
+   66   withFillOpacity 1 $
+   67   withStrokeWidth 0 $
+   68   flipYAxis $
+   69   SvgTree $ doc & width .~ Nothing
+   70                 & height .~ Nothing
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Svg.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Svg.hs.html new file mode 100644 index 0000000..ee69f97 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Svg.hs.html @@ -0,0 +1,371 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE LambdaCase #-}
+    2 {-|
+    3 Copyright   : Written by David Himmelstrup
+    4 License     : Unlicense
+    5 Maintainer  : lemmih@gmail.com
+    6 Stability   : experimental
+    7 Portability : POSIX
+    8 -}
+    9 module Reanimate.Svg
+   10   ( module Reanimate.Svg
+   11   , module Reanimate.Svg.Constructors
+   12   , module Reanimate.Svg.LineCommand
+   13   , module Reanimate.Svg.BoundingBox
+   14   , module Reanimate.Svg.Unuse
+   15   ) where
+   16 
+   17 import           Control.Lens                 ((%~), (&), (.~), (^.), (?~))
+   18 import           Control.Monad.State
+   19 import           Graphics.SvgTree             hiding (height, line, path, use,
+   20                                                width)
+   21 import           Linear.V2                    hiding (angle)
+   22 import           Reanimate.Constants
+   23 import           Reanimate.Animation (SVG)
+   24 import           Reanimate.Svg.Constructors
+   25 import           Reanimate.Svg.LineCommand
+   26 import           Reanimate.Svg.BoundingBox
+   27 import           Reanimate.Svg.Unuse
+   28 import qualified Reanimate.Transform          as Transform
+   29 
+   30 -- | Remove transformations (such as translations, rotations, scaling)
+   31 --   and apply them directly to the SVG nodes. Note, this function
+   32 --   may convert nodes (such as Circle or Rect) to paths. Also note
+   33 --   that /does/ change how the SVG is rendered. Particularly, stroke
+   34 --   width is affected by directly applying scaling.
+   35 --
+   36 --   @lowerTransformations (scale 2 (mkCircle 1)) = mkCircle 2@
+   37 lowerTransformations :: Tree -> Tree
+   38 lowerTransformations = worker False Transform.identity
+   39   where
+   40     updLineCmd m cmd =
+   41       case cmd of
+   42         LineMove p    -> LineMove $ Transform.transformPoint m p
+   43         -- LineDraw p -> LineDraw $ Transform.transformPoint m p
+   44         LineBezier ps -> LineBezier $ map (Transform.transformPoint m) ps
+   45         LineEnd p     -> LineEnd $ Transform.transformPoint m p
+   46     updPath m = lineToPath . map (updLineCmd m) . toLineCommands
+   47     updPoint m (Num a,Num b) =
+   48       case Transform.transformPoint m (V2 a b) of
+   49         V2 x y -> (Num x, Num y)
+   50     updPoint _ other = other -- XXX: Can we do better here?
+   51     worker hasPathified m t =
+   52       let m' = m * Transform.mkMatrix (t^.transform) in
+   53       case t of
+   54         PathTree path -> PathTree $
+   55           path & pathDefinition %~ updPath m'
+   56                & transform .~ Nothing
+   57         GroupTree g -> GroupTree $
+   58           g & groupChildren %~ map (worker hasPathified m')
+   59             & transform .~ Nothing
+   60         LineTree line ->
+   61           LineTree $
+   62             line & linePoint1 %~ updPoint m
+   63                  & linePoint2 %~ updPoint m
+   64         ClipPathTree{} -> t
+   65         -- If we encounter an unknown node and we've already tried to convert
+   66         -- to paths, give up and insert an explicit transformation.
+   67         _ | hasPathified ->
+   68           mkGroup [t] & transform ?~ [ Transform.toTransformation m ]
+   69         -- If we haven't tried to pathify, run pathify only once.
+   70         _ -> worker True m (pathify t)
+   71 
+   72 -- | Remove all @id@ attributes.
+   73 lowerIds :: Tree -> Tree
+   74 lowerIds = mapTree worker
+   75   where
+   76     worker t@GroupTree{} = t & attrId .~ Nothing
+   77     worker t@PathTree{}  = t & attrId .~ Nothing
+   78     worker t             = t
+   79 
+   80 -- | Optimize SVG tree without affecting how it is rendered.
+   81 simplify :: Tree -> Tree
+   82 simplify root =
+   83   case worker root of
+   84     []  -> None
+   85     [x] -> x
+   86     xs  -> mkGroup xs
+   87   where
+   88     worker None = []
+   89     worker (DefinitionTree d) =
+   90       concatMap dropNulls
+   91       [DefinitionTree $ d & groupChildren %~ concatMap worker]
+   92     worker (GroupTree g)
+   93       | g ^. drawAttributes == defaultSvg =
+   94         concatMap dropNulls $
+   95         concatMap worker (g^.groupChildren)
+   96       | otherwise =
+   97         dropNulls $
+   98         GroupTree $ g & groupChildren %~ concatMap worker
+   99     worker t = dropNulls t
+  100 
+  101     dropNulls None = []
+  102     dropNulls (DefinitionTree d)
+  103       | null (d^.groupChildren) = []
+  104     dropNulls (GroupTree g)
+  105       | null (g^.groupChildren) = []
+  106     dropNulls t = [t]
+  107 
+  108 -- | Separate grouped items. This is required by clip nodes.
+  109 --
+  110 -- @removeGroups (withFillColor "blue" $ mkGroup [mkCircle 1, mkRect 1 1])
+  111 --    = [ withFillColor "blue" $ mkCircle 1
+  112 --      , withFillColor "blue" $ mkRect 1 1 ]@
+  113 removeGroups :: Tree -> [Tree]
+  114 removeGroups = worker defaultSvg
+  115   where
+  116     worker _attr None = []
+  117     worker _attr (DefinitionTree d) =
+  118       concatMap dropNulls
+  119       [DefinitionTree $ d & groupChildren %~ concatMap (worker defaultSvg)]
+  120     worker attr (GroupTree g)
+  121       | g ^. drawAttributes == defaultSvg =
+  122         concatMap dropNulls $
+  123         concatMap (worker attr) (g^.groupChildren)
+  124       | otherwise =
+  125         concatMap (worker (attr <> g ^. drawAttributes)) (g^.groupChildren)
+  126     worker attr t = dropNulls (t & drawAttributes .~ attr)
+  127 
+  128     dropNulls None = []
+  129     dropNulls (DefinitionTree d)
+  130       | null (d^.groupChildren) = []
+  131     dropNulls (GroupTree g)
+  132       | null (g^.groupChildren) = []
+  133     dropNulls t = [t]
+  134 
+  135 -- | Extract all path commands from a node (and its children) and concatenate them.
+  136 extractPath :: Tree -> [PathCommand]
+  137 extractPath = worker . simplify . lowerTransformations . pathify
+  138   where
+  139     worker (GroupTree g) = concatMap worker (g^.groupChildren)
+  140     worker (PathTree p)  = p^.pathDefinition
+  141     worker _             = []
+  142 
+  143 -- | Map over indexed symbols.
+  144 --
+  145 --   @withSubglyphs [0,2] (scale 2) (mkGroup [mkCircle 1, mkRect 2, mkEllipse 1 2])
+  146 --      = mkGroup [scale 2 (mkCircle 1), mkRect 2, scale 2 (mkEllipse 1 2)]@
+  147 withSubglyphs :: [Int] -> (Tree -> Tree) -> Tree -> Tree
+  148 withSubglyphs target fn = \t -> evalState (worker t) 0
+  149   where
+  150     worker :: Tree -> State Int Tree
+  151     worker t =
+  152       case t of
+  153         GroupTree g -> do
+  154           cs <- mapM worker (g ^. groupChildren)
+  155           return $ GroupTree $ g & groupChildren .~ cs
+  156         PathTree{} -> handleGlyph t
+  157         CircleTree{} -> handleGlyph t
+  158         PolyLineTree{} -> handleGlyph t
+  159         PolygonTree{} -> handleGlyph t
+  160         EllipseTree{} -> handleGlyph t
+  161         LineTree{} -> handleGlyph t
+  162         RectangleTree{} -> handleGlyph t
+  163         _ -> return t
+  164     handleGlyph :: Tree -> State Int Tree
+  165     handleGlyph svg = do
+  166       n <- get <* modify (+1)
+  167       if n `elem` target
+  168         then return $ fn svg
+  169         else return svg
+  170 
+  171 -- | Split symbols.
+  172 --
+  173 --   @splitGlyphs [0,2] (mkGroup [mkCircle 1, mkRect 2, mkEllipse 1 2])
+  174 --      = ([mkRect 2], [mkCircle 1, mkEllipse 1 2])@
+  175 splitGlyphs :: [Int] -> Tree -> (Tree, Tree)
+  176 splitGlyphs target = \t ->
+  177     let (_, l, r) = execState (worker id t) (0, [], [])
+  178     in (mkGroup l, mkGroup r)
+  179   where
+  180     handleGlyph :: Tree -> State (Int, [Tree], [Tree]) ()
+  181     handleGlyph t = do
+  182       (n, l, r) <- get
+  183       if n `elem` target
+  184         then put (n+1, l, t:r)
+  185         else put (n+1, t:l, r)
+  186     worker :: (Tree -> Tree) -> Tree -> State (Int, [Tree], [Tree]) ()
+  187     worker acc t =
+  188       case t of
+  189         GroupTree g -> do
+  190           let acc' sub = acc (GroupTree $ g & groupChildren .~ [sub])
+  191           mapM_ (worker acc') (g ^. groupChildren)
+  192         PathTree{} -> handleGlyph $ acc t
+  193         CircleTree{} -> handleGlyph $ acc t
+  194         PolyLineTree{} -> handleGlyph $ acc t
+  195         PolygonTree{} -> handleGlyph $ acc t
+  196         EllipseTree{} -> handleGlyph $ acc t
+  197         LineTree{} -> handleGlyph $ acc t
+  198         RectangleTree{} -> handleGlyph $ acc t
+  199         DefinitionTree{} -> return ()
+  200         _ ->
+  201           modify $ \(n, l, r) -> (n, acc t:l, r)
+  202 {-
+  203 <g transform="translate(10,10)">
+  204   <g transform="scale(2)">
+  205     <circle/>
+  206   </g>
+  207   <g transform="scale(0.5)">
+  208     <rect/>
+  209   </g>
+  210 </g>
+  211 
+  212 [ (\svg -> <g transform="translate(10,10)"><g transform="scale(2)">svg</g></g>, <circle/>)
+  213 , (\svg -> <g transform="translate(10,10)"><g transform="scale(0.5)">svg</g></g>, <rect/>)]
+  214 -}
+  215 -- | Split symbols and include their context and drawing attributes.
+  216 svgGlyphs :: Tree -> [(Tree -> Tree, DrawAttributes, Tree)]
+  217 svgGlyphs = worker id defaultSvg
+  218   where
+  219     worker acc attr =
+  220       \case
+  221         None -> []
+  222         GroupTree g ->
+  223           let acc' sub = acc (GroupTree $ g & groupChildren .~ [sub])
+  224               attr' = (g^.drawAttributes) `mappend` attr
+  225           in concatMap (worker acc' attr') (g ^. groupChildren)
+  226         t -> [(acc, (t^.drawAttributes) `mappend` attr, t)]
+  227 
+  228 {-| Convert primitive SVG shapes (like those created by 'mkCircle', 'mkRect', 'mkLine' or
+  229     'mkEllipse') into SVG path. This can be useful for creating animations of these shapes being
+  230     drawn progressively with 'partialSvg'.
+  231 
+  232     Example:
+  233 
+  234     > pathifyExample :: Animation
+  235     > pathifyExample = animate $ \t -> gridLayout
+  236     >     [ [ partialSvg t $ pathify $ mkCircle 1
+  237     >       , partialSvg t $ pathify $ mkRect 2 2
+  238     >       ]
+  239     >     , [ partialSvg t $ pathify $ mkEllipse 1 0.5
+  240     >       , partialSvg t $ pathify $ mkLine (-1, -1) (1, 1)
+  241     >       ]
+  242     >     ]
+  243 
+  244     <<docs/gifs/doc_pathify.gif>>
+  245  -}
+  246 pathify :: Tree -> Tree
+  247 pathify = mapTree worker
+  248   where
+  249     worker =
+  250       \case
+  251         RectangleTree rect | Just (x,y,w,h) <- unpackRect rect ->
+  252           PathTree $ defaultSvg
+  253             & drawAttributes .~ rect ^. drawAttributes
+  254             & strokeLineCap .~ pure CapSquare
+  255             & pathDefinition .~
+  256               [MoveTo OriginAbsolute [V2 x y]
+  257               ,HorizontalTo OriginRelative [w]
+  258               ,VerticalTo OriginRelative [h]
+  259               ,HorizontalTo OriginRelative [-w]
+  260               ,EndPath ]
+  261         LineTree line | Just (x1,y1, x2, y2) <- unpackLine line ->
+  262           PathTree $ defaultSvg
+  263             & drawAttributes .~ line ^. drawAttributes
+  264             & pathDefinition .~
+  265               [MoveTo OriginAbsolute [V2 x1 y1]
+  266               ,LineTo OriginAbsolute [V2 x2 y2] ]
+  267         CircleTree circ | Just (x, y, r) <- unpackCircle circ ->
+  268           PathTree $ defaultSvg
+  269             & drawAttributes .~ circ ^. drawAttributes
+  270             & pathDefinition .~
+  271               [MoveTo OriginAbsolute [V2 (x-r) y]
+  272               ,EllipticalArc OriginRelative [(r, r, 0,True,False,V2 (r*2) 0)
+  273                                             ,(r, r, 0,True,False,V2 (-r*2) 0)]]
+  274         PolyLineTree pl ->
+  275           let points = pl ^. polyLinePoints
+  276           in PathTree $ defaultSvg
+  277                & drawAttributes .~ pl ^. drawAttributes
+  278                & pathDefinition .~ pointsToPathCommands points
+  279         PolygonTree pg ->
+  280           let points = pg ^. polygonPoints
+  281           in PathTree $ defaultSvg
+  282                & drawAttributes .~ pg ^. drawAttributes
+  283                -- Polygon automatically connects the last point to the first. For path we must do
+  284                -- it explicitly
+  285                & pathDefinition .~ (pointsToPathCommands points ++ [EndPath])
+  286         EllipseTree elip | Just (cx,cy,rx,ry) <- unpackEllipse elip ->
+  287           PathTree $ defaultSvg
+  288              & drawAttributes .~ elip ^. drawAttributes
+  289              & pathDefinition .~
+  290                [ MoveTo OriginAbsolute [V2 (cx-rx) cy]
+  291                , EllipticalArc OriginRelative [(rx, ry, 0,True,False,V2 (rx*2) 0)
+  292                                               ,(rx, ry, 0,True,False,V2 (-rx*2) 0)]]
+  293         t -> t
+  294     unpackCircle circ = do
+  295       let (x,y) = circ ^. circleCenter
+  296       liftM3 (,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ circ ^. circleRadius)
+  297     unpackEllipse elip = do
+  298       let (x,y) = elip ^. ellipseCenter
+  299       liftM4 (,,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ elip ^. ellipseXRadius)
+  300                   (unpackNumber $ elip ^. ellipseYRadius)
+  301     unpackLine line = do
+  302       let (x1,y1) = line ^. linePoint1
+  303           (x2,y2) = line ^. linePoint2
+  304       liftM4 (,,,) (unpackNumber x1) (unpackNumber y1) (unpackNumber x2) (unpackNumber y2)
+  305     unpackRect rect = do
+  306       let (x', y') = rect ^. rectUpperLeftCorner
+  307       x <- unpackNumber x'
+  308       y <- unpackNumber y'
+  309       w <- unpackNumber =<< rect ^. rectWidth
+  310       h <- unpackNumber =<< rect ^. rectHeight
+  311       return (x,y,w,h)
+  312     pointsToPathCommands points = case points of
+  313       [] -> []
+  314       (p:ps) -> [ MoveTo OriginAbsolute [p]
+  315                 , LineTo OriginAbsolute ps ]
+  316     unpackNumber n =
+  317       case toUserUnit defaultDPI n of
+  318         Num d -> Just d
+  319         _     -> Nothing
+  320 
+  321 -- | Map over all recursively-found path commands.
+  322 mapSvgPaths :: ([PathCommand] -> [PathCommand]) -> SVG -> SVG
+  323 mapSvgPaths fn = mapTree worker
+  324   where
+  325     worker =
+  326       \case
+  327         PathTree path -> PathTree $
+  328           path & pathDefinition %~ fn
+  329         t -> t
+  330 
+  331 -- | Map over all recursively-found line commands.
+  332 mapSvgLines :: ([LineCommand] -> [LineCommand]) -> SVG -> SVG
+  333 mapSvgLines fn = mapSvgPaths (lineToPath . fn . toLineCommands)
+  334 
+  335 -- Only maps points in paths
+  336 -- | Map over all line command control points.
+  337 mapSvgPoints :: (RPoint -> RPoint) -> SVG -> SVG
+  338 mapSvgPoints fn = mapSvgLines (map worker)
+  339   where
+  340     worker (LineMove p) = LineMove (fn p)
+  341     worker (LineBezier ps) = LineBezier (map fn ps)
+  342     worker (LineEnd p) = LineEnd (fn p)
+  343 
+  344 -- | Convert coordinate system from degrees to radians.
+  345 svgPointsToRadians :: SVG -> SVG
+  346 svgPointsToRadians = mapSvgPoints worker
+  347   where
+  348     worker (V2 x y) = V2 (x/180*pi) (y/180*pi)
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Transform.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Transform.hs.html new file mode 100644 index 0000000..a1b9996 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Transform.hs.html @@ -0,0 +1,92 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE BangPatterns   #-}
+    2 {-|
+    3   2D transformation matrices capable of translating, scaling,
+    4   rotating, and skewing.
+    5 -}
+    6 module Reanimate.Transform
+    7   ( identity
+    8   , transformPoint
+    9   , mkMatrix
+   10   , toTransformation
+   11   ) where
+   12 
+   13 -- XXX: Use Linear.Matrix instead of Data.Matrix to drop the 'matrix' dependency.
+   14 import           Data.List
+   15 import           Data.Matrix (Matrix)
+   16 import qualified Data.Matrix as M
+   17 import           Data.Maybe
+   18 import           Graphics.SvgTree
+   19 import           Linear.V2
+   20 
+   21 -- | Identity matrix.
+   22 --
+   23 --   @transformPoints identity x = x@
+   24 identity :: Matrix Coord
+   25 identity = M.identity 3
+   26 
+   27 fromList :: [Coord] -> Matrix Coord
+   28 fromList [a,b,c,d,e,f] = M.fromList 3 3 [a,c,e,b,d,f,0,0,1]
+   29 fromList _             = error "Reanimate.Transform.fromList: bad input"
+   30 
+   31 -- | Apply a transformation matrix to a 2D point.
+   32 transformPoint :: Matrix Coord -> RPoint -> RPoint
+   33 transformPoint m (V2 x y) = V2 (a*x +c*y + e) (b*x + d*y +f)
+   34   where
+   35     !a = M.unsafeGet 1 1 m
+   36     !c = M.unsafeGet 1 2 m
+   37     !e = M.unsafeGet 1 3 m
+   38     !b = M.unsafeGet 2 1 m
+   39     !d = M.unsafeGet 2 2 m
+   40     !f = M.unsafeGet 2 3 m
+   41     -- (a:c:e:b:d:f:_) = M.toList m
+   42 
+   43 -- | Convert multiple SVG transformations into a single transformation matrix.
+   44 mkMatrix :: Maybe [Transformation] -> Matrix Coord
+   45 mkMatrix Nothing   = identity
+   46 mkMatrix (Just ts) = foldl' (*) identity (map transformationMatrix ts)
+   47 
+   48 -- | Convert an SVG transformation into a transformation matrix.
+   49 transformationMatrix :: Transformation -> Matrix Coord
+   50 transformationMatrix transformation =
+   51   case transformation of
+   52     TransformMatrix a b c d e f -> fromList [a,b,c,d,e,f]
+   53     Translate x y               -> translate x y
+   54     Scale sx mbSy               -> fromList [sx,0,0,fromMaybe sx mbSy,0,0]
+   55     Rotate a Nothing            -> rotate a
+   56     Rotate a (Just (x,y))       -> translate x y * rotate a * translate (-x) (-y)
+   57     SkewX a                     -> fromList [1,0,tan (a*pi/180),1,0,0]
+   58     SkewY a                     -> fromList [1,tan (a*pi/180),0,1,0,0]
+   59     TransformUnknown            -> identity
+   60   where
+   61     translate x y = fromList [1,0,0,1,x,y]
+   62     rotate a = fromList [cos r,sin r,-sin r,cos r,0,0]
+   63       where r = a * pi / 180
+   64 
+   65 -- | Convert a transformation matrix back into an SVG transformation.
+   66 toTransformation :: Matrix Coord -> Transformation
+   67 toTransformation m = TransformMatrix a b c d e f
+   68   where
+   69     [a,c,e,b,d,f,_,_,_] = M.toList m
+
+
+ + diff --git a/reanimate-0.4.2.0-inplace/Reanimate.Transition.hs.html b/reanimate-0.4.2.0-inplace/Reanimate.Transition.hs.html new file mode 100644 index 0000000..bf56491 --- /dev/null +++ b/reanimate-0.4.2.0-inplace/Reanimate.Transition.hs.html @@ -0,0 +1,99 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-|
+    2 Copyright   : Written by David Himmelstrup
+    3 License     : Unlicense
+    4 Maintainer  : lemmih@gmail.com
+    5 Stability   : experimental
+    6 Portability : POSIX
+    7 -}
+    8 module Reanimate.Transition
+    9   ( Transition
+   10   , signalT
+   11   , mapT
+   12   , overlapT
+   13   , chainT
+   14   , effectT
+   15   , fadeT
+   16   ) where
+   17 
+   18 import Reanimate.Animation
+   19 import Reanimate.Ease
+   20 import Reanimate.Effect
+   21 
+   22 -- | A transition transforms one animation into another.
+   23 type Transition = Animation -> Animation -> Animation
+   24 
+   25 -- | Apply a signal to the timing of a transition.
+   26 signalT :: Signal -> Transition -> Transition
+   27 signalT = mapT . signalA
+   28 
+   29 -- | Map the result of a transition.
+   30 mapT :: (Animation -> Animation) -> Transition -> Transition
+   31 mapT fn t a b = fn (t a b)
+   32 
+   33 -- | Apply transition only to @N@ seconds of the first
+   34 --   animation and to the last @N@ seconds of the second animation.
+   35 --
+   36 --   Example:
+   37 --
+   38 --   > overlapT 0.5 fadeT drawBox drawCircle
+   39 --
+   40 --   <<docs/gifs/doc_overlapT.gif>>
+   41 overlapT :: Double -> Transition -> Transition
+   42 overlapT overlap t a b =
+   43     aBefore `seqA` t aOverlap bOverlap `seqA` bAfter
+   44   where
+   45     aBefore  = takeA (duration a - overlap) a
+   46     aOverlap = lastA overlap a
+   47     bOverlap = takeA overlap b
+   48     bAfter   = dropA overlap b
+   49 
+   50 
+   51 -- | Create a transition between two animations by applying an effect to each respective animation.
+   52 effectT :: Effect -- ^ Effect to be applied to the first animation.
+   53         -> Effect -- ^ Effect to be applied to the second animation.
+   54         -> Transition
+   55 effectT eA eB a b = applyE eA a `parA` applyE eB b
+   56 
+   57 -- | Combine a list of animations using a given transition.
+   58 --
+   59 --   Example:
+   60 --
+   61 --   > chainT (overlapT 0.5 fadeT) [drawBox, drawCircle, drawProgress]
+   62 --
+   63 --   <<docs/gifs/doc_chainT.gif>>
+   64 chainT :: Transition -> [Animation] -> Animation
+   65 chainT _ [] = pause 0
+   66 chainT t (x:xs) = foldl t x xs
+   67 
+   68 -- | Fade out left-hand-side animation while fading in right-hand-side animation.
+   69 --
+   70 --   Example:
+   71 --
+   72 --   > drawBox `fadeT` drawCircle
+   73 --
+   74 --   <<docs/gifs/doc_fadeT.gif>>
+   75 fadeT :: Transition
+   76 fadeT = effectT fadeOutE fadeInE
+
+
+ +
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation  module reanimate-0.4.2.0-inplace/Reanimate.Builtin.Documentation 100%6/6
- 0/0 100%117/117
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Slide  module reanimate-0.4.2.0-inplace/Reanimate.Builtin.Slide 100%3/3
- 0/0 90%54/60
  module reanimate-0.4.1.0-inplace/Reanimate.ColorMap  module reanimate-0.4.2.0-inplace/Reanimate.ColorMap 100%14/14
60%3/5
99%1176/1180
  module reanimate-0.4.1.0-inplace/Reanimate.Transition  module reanimate-0.4.2.0-inplace/Reanimate.Transition 100%6/6
50%1/2
95%43/45
  module reanimate-0.4.1.0-inplace/Reanimate.Animation  module reanimate-0.4.2.0-inplace/Reanimate.Animation 90%28/31
57%8/14
87%298/341
  module reanimate-0.4.1.0-inplace/Reanimate.Ease  module reanimate-0.4.2.0-inplace/Reanimate.Ease 87%7/8
100%4/4
96%85/88
  module reanimate-0.4.1.0-inplace/Reanimate.Transform  module reanimate-0.4.2.0-inplace/Reanimate.Transform 83%5/6
33%4/12
45%76/166
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.LineCommand  module reanimate-0.4.2.0-inplace/Reanimate.Svg.LineCommand 80%12/15
58%43/74
70%659/937
  module reanimate-0.4.1.0-inplace/Reanimate.ColorComponents  module reanimate-0.4.2.0-inplace/Reanimate.ColorComponents 75%9/12
50%1/2
81%135/166
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Constructors  module reanimate-0.4.2.0-inplace/Reanimate.Svg.Constructors 67%33/49
37%3/8
65%369/565
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Images  module reanimate-0.4.2.0-inplace/Reanimate.Builtin.Images 57%4/7
25%1/4
48%24/49
  module reanimate-0.4.1.0-inplace/Reanimate.Effect  module reanimate-0.4.2.0-inplace/Reanimate.Effect 52%9/17
66%4/6
53%67/125
  module reanimate-0.4.1.0-inplace/Reanimate.Morph.Linear  module reanimate-0.4.2.0-inplace/Reanimate.Morph.Linear 40%2/5
16%1/6
26%22/83
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.BoundingBox  module reanimate-0.4.2.0-inplace/Reanimate.Svg.BoundingBox 40%2/5
16%6/36
26%76/282
  module reanimate-0.4.1.0-inplace/Reanimate.Svg  module reanimate-0.4.2.0-inplace/Reanimate.Svg 38%5/13
18%15/80
41%323/777
  module reanimate-0.4.1.0-inplace/Reanimate.Constants  module reanimate-0.4.2.0-inplace/Reanimate.Constants 37%3/8
- 0/0 16%3/18
  module reanimate-0.4.1.0-inplace/Reanimate.LaTeX  module reanimate-0.4.2.0-inplace/Reanimate.LaTeX 33%4/12
11%1/9
7%12/167
  module reanimate-0.4.1.0-inplace/Reanimate.Morph.Common  module reanimate-0.4.2.0-inplace/Reanimate.Morph.Common 33%5/15
5%1/20
40%133/325
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Unuse  module reanimate-0.4.2.0-inplace/Reanimate.Svg.Unuse 33%1/3
0%0/14
21%28/128
  module reanimate-0.4.1.0-inplace/Reanimate.Scene  module reanimate-0.4.2.0-inplace/Reanimate.Scene 30%40/130
60%15/25
36%545/1483
  module reanimate-0.4.1.0-inplace/Reanimate.PolyShape  module reanimate-0.4.2.0-inplace/Reanimate.PolyShape 22%8/35
27%13/48
18%127/691
  module reanimate-0.4.1.0-inplace/Geom2D.CubicBezier.Linear  module reanimate-0.4.2.0-inplace/Geom2D.CubicBezier.Linear 20%20/99
5%2/36
28%102/356
  module reanimate-0.4.1.0-inplace/Paths_reanimate  module reanimate-0.4.2.0-inplace/Paths_reanimate 20%3/15
- 0/0 20%12/58
  module reanimate-0.4.1.0-inplace/Reanimate.Parameters  module reanimate-0.4.2.0-inplace/Reanimate.Parameters 15%3/20
- 0/0 14%7/49
  module reanimate-0.4.1.0-inplace/Reanimate.Raster  module reanimate-0.4.2.0-inplace/Reanimate.Raster 15%2/13
0%0/17
11%52/443
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.CLI  module reanimate-0.4.2.0-inplace/Reanimate.Driver.CLI 14%5/35
0%0/63
8%31/376
  module reanimate-0.4.1.0-inplace/Reanimate.Driver  module reanimate-0.4.2.0-inplace/Reanimate.Driver 8%1/12
1%1/55
3%9/246
  module reanimate-0.4.1.0-inplace/Reanimate.Math.Polygon  module reanimate-0.4.2.0-inplace/Reanimate.Math.Polygon 8%7/82
5%4/79
2%58/2494
  module reanimate-0.4.1.0-inplace/Reanimate.Render  module reanimate-0.4.2.0-inplace/Reanimate.Render 5%1/19
0%0/50
4%39/826
  module reanimate-0.4.1.0-inplace/Reanimate.Cache  module reanimate-0.4.2.0-inplace/Reanimate.Cache 0%0/8
0%0/12
0%0/160
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Check  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Check 0%0/21
0%0/27
0%0/396
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Compile  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Compile 0%0/2
0%0/4
0%0/64
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Magick  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Magick 0%0/1
- 0/0 0%0/12
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Server  module reanimate-0.4.2.0-inplace/Reanimate.Driver.Server 0%0/16
0%0/30
0%0/634
  module reanimate-0.4.1.0-inplace/Reanimate.Math.Common  module reanimate-0.4.2.0-inplace/Reanimate.Math.Common 0%0/26
0%0/12
0%0/407
  module reanimate-0.4.1.0-inplace/Reanimate.Math.SSSP  module reanimate-0.4.2.0-inplace/Reanimate.Math.SSSP 0%0/16
0%0/43
0%0/854
  module reanimate-0.4.1.0-inplace/Reanimate.Math.Triangulate  module reanimate-0.4.2.0-inplace/Reanimate.Math.Triangulate 0%0/5
- 0/0 0%0/139
  module reanimate-0.4.1.0-inplace/Reanimate.Misc  module reanimate-0.4.2.0-inplace/Reanimate.Misc 0%0/7
0%0/14
0%0/162
  module reanimate-0.4.1.0-inplace/Reanimate.Morph.Cache  module reanimate-0.4.2.0-inplace/Reanimate.Morph.Cache 0%0/1
0%0/4
0%0/61
  Program Coverage Total