From 90b4292770c49858e6b1198507b5d8f0fcba7545 Mon Sep 17 00:00:00 2001 From: Lemmih Date: Sun, 20 Sep 2020 06:05:55 +0000 Subject: [PATCH] =?UTF-8?q?Deploying=20to=20gh-pages=20from=20=20@=2037aa9?= =?UTF-8?q?0378eab5454154a76265aa887c1edbf31db=20=F0=9F=9A=80?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- hpc_index.html | 82 +- hpc_index_alt.html | 82 +- hpc_index_exp.html | 82 +- hpc_index_fun.html | 82 +- playground/snippets.js | 2 +- .../Geom2D.CubicBezier.Linear.hs.html | 366 ++++++++ .../Paths_reanimate.hs.html | 73 ++ .../Reanimate.Animation.hs.html | 414 +++++++++ .../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 | 251 ++++++ .../Reanimate.Driver.Check.hs.html | 229 +++++ .../Reanimate.Driver.Compile.hs.html | 58 ++ .../Reanimate.Driver.Magick.hs.html | 42 + .../Reanimate.Driver.Server.hs.html | 323 +++++++ .../Reanimate.Driver.hs.html | 246 ++++++ .../Reanimate.Ease.hs.html | 147 ++++ .../Reanimate.Effect.hs.html | 154 ++++ .../Reanimate.LaTeX.hs.html | 205 +++++ .../Reanimate.Math.Common.hs.html | 243 ++++++ .../Reanimate.Math.Polygon.hs.html | 803 ++++++++++++++++++ .../Reanimate.Math.SSSP.hs.html | 390 +++++++++ .../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 | 118 +++ .../Reanimate.Parameters.hs.html | 145 ++++ .../Reanimate.PolyShape.hs.html | 472 ++++++++++ .../Reanimate.Raster.hs.html | 339 ++++++++ .../Reanimate.Render.hs.html | 445 ++++++++++ .../Reanimate.Scene.Core.hs.html | 183 ++++ .../Reanimate.Scene.Sprite.hs.html | 439 ++++++++++ .../Reanimate.Scene.Var.hs.html | 192 +++++ .../Reanimate.Svg.BoundingBox.hs.html | 153 ++++ .../Reanimate.Svg.Constructors.hs.html | 449 ++++++++++ .../Reanimate.Svg.LineCommand.hs.html | 315 +++++++ .../Reanimate.Svg.Unuse.hs.html | 92 ++ .../Reanimate.Svg.hs.html | 370 ++++++++ .../Reanimate.Transform.hs.html | 92 ++ .../Reanimate.Transition.hs.html | 105 +++ 46 files changed, 9694 insertions(+), 165 deletions(-) create mode 100644 reanimate-1.0.0.0-inplace/Geom2D.CubicBezier.Linear.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Paths_reanimate.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Animation.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Builtin.Documentation.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Builtin.Images.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Builtin.Slide.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Cache.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.ColorComponents.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.ColorMap.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Constants.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Driver.CLI.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Driver.Check.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Driver.Compile.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Driver.Magick.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Driver.Server.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Driver.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Ease.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Effect.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.LaTeX.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Math.Common.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Math.Polygon.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Math.SSSP.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Math.Triangulate.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Misc.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Morph.Cache.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Morph.Common.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Morph.Linear.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Parameters.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.PolyShape.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Raster.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Render.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Scene.Core.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Scene.Sprite.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Scene.Var.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Svg.BoundingBox.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Svg.Constructors.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Svg.LineCommand.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Svg.Unuse.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Svg.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Transform.hs.html create mode 100644 reanimate-1.0.0.0-inplace/Reanimate.Transition.hs.html diff --git a/hpc_index.html b/hpc_index.html index 775e643..17160e6 100644 --- a/hpc_index.html +++ b/hpc_index.html @@ -7,127 +7,127 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black } - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + diff --git a/hpc_index_alt.html b/hpc_index_alt.html index bf17efb..1fad4fd 100644 --- a/hpc_index_alt.html +++ b/hpc_index_alt.html @@ -7,127 +7,127 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
  module reanimate-0.5.0.1-inplace/Geom2D.CubicBezier.Linear  module reanimate-1.0.0.0-inplace/Geom2D.CubicBezier.Linear 19%20/101
5%2/36
27%97/347
  module reanimate-0.5.0.1-inplace/Paths_reanimate  module reanimate-1.0.0.0-inplace/Paths_reanimate 20%3/15
- 0/0 20%12/58
  module reanimate-0.5.0.1-inplace/Reanimate.Animation  module reanimate-1.0.0.0-inplace/Reanimate.Animation 90%28/31
57%8/14
87%298/341
  module reanimate-0.5.0.1-inplace/Reanimate.Builtin.Documentation  module reanimate-1.0.0.0-inplace/Reanimate.Builtin.Documentation 100%6/6
- 0/0 100%117/117
  module reanimate-0.5.0.1-inplace/Reanimate.Builtin.Images  module reanimate-1.0.0.0-inplace/Reanimate.Builtin.Images 57%4/7
25%1/4
48%24/49
  module reanimate-0.5.0.1-inplace/Reanimate.Builtin.Slide  module reanimate-1.0.0.0-inplace/Reanimate.Builtin.Slide 100%3/3
- 0/0 90%54/60
  module reanimate-0.5.0.1-inplace/Reanimate.Cache  module reanimate-1.0.0.0-inplace/Reanimate.Cache 0%0/8
0%0/12
0%0/160
  module reanimate-0.5.0.1-inplace/Reanimate.ColorComponents  module reanimate-1.0.0.0-inplace/Reanimate.ColorComponents 75%9/12
50%1/2
81%135/166
  module reanimate-0.5.0.1-inplace/Reanimate.ColorMap  module reanimate-1.0.0.0-inplace/Reanimate.ColorMap 100%14/14
60%3/5
99%1176/1180
  module reanimate-0.5.0.1-inplace/Reanimate.Constants  module reanimate-1.0.0.0-inplace/Reanimate.Constants 37%3/8
- 0/0 16%3/18
  module reanimate-0.5.0.1-inplace/Reanimate.Driver  module reanimate-1.0.0.0-inplace/Reanimate.Driver 8%1/12
1%1/55
3%9/245
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.CLI  module reanimate-1.0.0.0-inplace/Reanimate.Driver.CLI 13%5/36
0%0/65
7%31/388
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Check  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Check 0%0/21
0%0/27
0%0/396
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Compile  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Compile 0%0/2
0%0/4
0%0/64
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Magick  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Magick 0%0/1
- 0/0 0%0/12
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Server  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Server 0%0/17
0%0/30
0%0/625
  module reanimate-0.5.0.1-inplace/Reanimate.Ease  module reanimate-1.0.0.0-inplace/Reanimate.Ease 87%7/8
100%4/4
96%85/88
  module reanimate-0.5.0.1-inplace/Reanimate.Effect  module reanimate-1.0.0.0-inplace/Reanimate.Effect 52%9/17
66%4/6
53%67/125
  module reanimate-0.5.0.1-inplace/Reanimate.LaTeX  module reanimate-1.0.0.0-inplace/Reanimate.LaTeX 33%4/12
11%1/9
7%12/167
  module reanimate-0.5.0.1-inplace/Reanimate.Math.Common  module reanimate-1.0.0.0-inplace/Reanimate.Math.Common 0%0/26
0%0/12
0%0/407
  module reanimate-0.5.0.1-inplace/Reanimate.Math.Polygon  module reanimate-1.0.0.0-inplace/Reanimate.Math.Polygon 9%8/82
5%4/75
2%59/2409
  module reanimate-0.5.0.1-inplace/Reanimate.Math.SSSP  module reanimate-1.0.0.0-inplace/Reanimate.Math.SSSP 0%0/19
0%0/53
0%0/909
  module reanimate-0.5.0.1-inplace/Reanimate.Math.Triangulate  module reanimate-1.0.0.0-inplace/Reanimate.Math.Triangulate 0%0/5
- 0/0 0%0/139
  module reanimate-0.5.0.1-inplace/Reanimate.Misc  module reanimate-1.0.0.0-inplace/Reanimate.Misc 0%0/7
0%0/14
0%0/162
  module reanimate-0.5.0.1-inplace/Reanimate.Morph.Cache  module reanimate-1.0.0.0-inplace/Reanimate.Morph.Cache 0%0/1
0%0/4
0%0/61
  module reanimate-0.5.0.1-inplace/Reanimate.Morph.Common  module reanimate-1.0.0.0-inplace/Reanimate.Morph.Common 33%5/15
17%4/23
41%138/329
  module reanimate-0.5.0.1-inplace/Reanimate.Morph.Linear  module reanimate-1.0.0.0-inplace/Reanimate.Morph.Linear 40%2/5
16%1/6
26%22/83
  module reanimate-0.5.0.1-inplace/Reanimate.Parameters  module reanimate-1.0.0.0-inplace/Reanimate.Parameters 15%3/20
- 0/0 14%7/49
  module reanimate-0.5.0.1-inplace/Reanimate.PolyShape  module reanimate-1.0.0.0-inplace/Reanimate.PolyShape 22%8/35
27%13/48
18%127/691
  module reanimate-0.5.0.1-inplace/Reanimate.Raster  module reanimate-1.0.0.0-inplace/Reanimate.Raster 15%2/13
0%0/17
11%52/443
  module reanimate-0.5.0.1-inplace/Reanimate.Render  module reanimate-1.0.0.0-inplace/Reanimate.Render 5%1/19
0%0/53
4%39/852
  module reanimate-0.5.0.1-inplace/Reanimate.Scene.Core  module reanimate-1.0.0.0-inplace/Reanimate.Scene.Core 66%12/18
- 0/0 72%172/236
  module reanimate-0.5.0.1-inplace/Reanimate.Scene.Sprite  module reanimate-1.0.0.0-inplace/Reanimate.Scene.Sprite 85%23/27
57%11/19
78%314/400
  module reanimate-0.5.0.1-inplace/Reanimate.Scene.Var  module reanimate-1.0.0.0-inplace/Reanimate.Scene.Var 89%17/19
60%14/23
68%214/313
  module reanimate-0.5.0.1-inplace/Reanimate.Svg  module reanimate-1.0.0.0-inplace/Reanimate.Svg 38%5/13
18%15/80
41%323/777
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.BoundingBox  module reanimate-1.0.0.0-inplace/Reanimate.Svg.BoundingBox 40%2/5
16%6/36
26%76/282
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.Constructors  module reanimate-1.0.0.0-inplace/Reanimate.Svg.Constructors 67%33/49
37%3/8
65%368/563
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.LineCommand  module reanimate-1.0.0.0-inplace/Reanimate.Svg.LineCommand 80%12/15
58%43/74
70%659/937
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.Unuse  module reanimate-1.0.0.0-inplace/Reanimate.Svg.Unuse 33%1/3
0%0/14
22%28/127
  module reanimate-0.5.0.1-inplace/Reanimate.Transform  module reanimate-1.0.0.0-inplace/Reanimate.Transform 83%5/6
33%4/12
45%76/166
  module reanimate-0.5.0.1-inplace/Reanimate.Transition  module reanimate-1.0.0.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 a1aff0d..e805ff2 100644 --- a/hpc_index_exp.html +++ b/hpc_index_exp.html @@ -7,127 +7,127 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
  module reanimate-0.5.0.1-inplace/Reanimate.Ease  module reanimate-1.0.0.0-inplace/Reanimate.Ease 87%7/8
100%4/4
96%85/88
  module reanimate-0.5.0.1-inplace/Reanimate.Effect  module reanimate-1.0.0.0-inplace/Reanimate.Effect 52%9/17
66%4/6
53%67/125
  module reanimate-0.5.0.1-inplace/Reanimate.ColorMap  module reanimate-1.0.0.0-inplace/Reanimate.ColorMap 100%14/14
60%3/5
99%1176/1180
  module reanimate-0.5.0.1-inplace/Reanimate.Scene.Var  module reanimate-1.0.0.0-inplace/Reanimate.Scene.Var 89%17/19
60%14/23
68%214/313
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.LineCommand  module reanimate-1.0.0.0-inplace/Reanimate.Svg.LineCommand 80%12/15
58%43/74
70%659/937
  module reanimate-0.5.0.1-inplace/Reanimate.Animation  module reanimate-1.0.0.0-inplace/Reanimate.Animation 90%28/31
57%8/14
87%298/341
  module reanimate-0.5.0.1-inplace/Reanimate.Scene.Sprite  module reanimate-1.0.0.0-inplace/Reanimate.Scene.Sprite 85%23/27
57%11/19
78%314/400
  module reanimate-0.5.0.1-inplace/Reanimate.ColorComponents  module reanimate-1.0.0.0-inplace/Reanimate.ColorComponents 75%9/12
50%1/2
81%135/166
  module reanimate-0.5.0.1-inplace/Reanimate.Transition  module reanimate-1.0.0.0-inplace/Reanimate.Transition 100%6/6
50%1/2
95%43/45
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.Constructors  module reanimate-1.0.0.0-inplace/Reanimate.Svg.Constructors 67%33/49
37%3/8
65%368/563
  module reanimate-0.5.0.1-inplace/Reanimate.Transform  module reanimate-1.0.0.0-inplace/Reanimate.Transform 83%5/6
33%4/12
45%76/166
  module reanimate-0.5.0.1-inplace/Reanimate.PolyShape  module reanimate-1.0.0.0-inplace/Reanimate.PolyShape 22%8/35
27%13/48
18%127/691
  module reanimate-0.5.0.1-inplace/Reanimate.Builtin.Images  module reanimate-1.0.0.0-inplace/Reanimate.Builtin.Images 57%4/7
25%1/4
48%24/49
  module reanimate-0.5.0.1-inplace/Reanimate.Svg  module reanimate-1.0.0.0-inplace/Reanimate.Svg 38%5/13
18%15/80
41%323/777
  module reanimate-0.5.0.1-inplace/Reanimate.Morph.Common  module reanimate-1.0.0.0-inplace/Reanimate.Morph.Common 33%5/15
17%4/23
41%138/329
  module reanimate-0.5.0.1-inplace/Reanimate.Morph.Linear  module reanimate-1.0.0.0-inplace/Reanimate.Morph.Linear 40%2/5
16%1/6
26%22/83
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.BoundingBox  module reanimate-1.0.0.0-inplace/Reanimate.Svg.BoundingBox 40%2/5
16%6/36
26%76/282
  module reanimate-0.5.0.1-inplace/Reanimate.LaTeX  module reanimate-1.0.0.0-inplace/Reanimate.LaTeX 33%4/12
11%1/9
7%12/167
  module reanimate-0.5.0.1-inplace/Geom2D.CubicBezier.Linear  module reanimate-1.0.0.0-inplace/Geom2D.CubicBezier.Linear 19%20/101
5%2/36
27%97/347
  module reanimate-0.5.0.1-inplace/Reanimate.Math.Polygon  module reanimate-1.0.0.0-inplace/Reanimate.Math.Polygon 9%8/82
5%4/75
2%59/2409
  module reanimate-0.5.0.1-inplace/Reanimate.Driver  module reanimate-1.0.0.0-inplace/Reanimate.Driver 8%1/12
1%1/55
3%9/245
  module reanimate-0.5.0.1-inplace/Reanimate.Cache  module reanimate-1.0.0.0-inplace/Reanimate.Cache 0%0/8
0%0/12
0%0/160
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.CLI  module reanimate-1.0.0.0-inplace/Reanimate.Driver.CLI 13%5/36
0%0/65
7%31/388
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Check  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Check 0%0/21
0%0/27
0%0/396
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Compile  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Compile 0%0/2
0%0/4
0%0/64
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Server  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Server 0%0/17
0%0/30
0%0/625
  module reanimate-0.5.0.1-inplace/Reanimate.Math.Common  module reanimate-1.0.0.0-inplace/Reanimate.Math.Common 0%0/26
0%0/12
0%0/407
  module reanimate-0.5.0.1-inplace/Reanimate.Math.SSSP  module reanimate-1.0.0.0-inplace/Reanimate.Math.SSSP 0%0/19
0%0/53
0%0/909
  module reanimate-0.5.0.1-inplace/Reanimate.Misc  module reanimate-1.0.0.0-inplace/Reanimate.Misc 0%0/7
0%0/14
0%0/162
  module reanimate-0.5.0.1-inplace/Reanimate.Morph.Cache  module reanimate-1.0.0.0-inplace/Reanimate.Morph.Cache 0%0/1
0%0/4
0%0/61
  module reanimate-0.5.0.1-inplace/Reanimate.Raster  module reanimate-1.0.0.0-inplace/Reanimate.Raster 15%2/13
0%0/17
11%52/443
  module reanimate-0.5.0.1-inplace/Reanimate.Render  module reanimate-1.0.0.0-inplace/Reanimate.Render 5%1/19
0%0/53
4%39/852
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.Unuse  module reanimate-1.0.0.0-inplace/Reanimate.Svg.Unuse 33%1/3
0%0/14
22%28/127
  module reanimate-0.5.0.1-inplace/Paths_reanimate  module reanimate-1.0.0.0-inplace/Paths_reanimate 20%3/15
- 0/0 20%12/58
  module reanimate-0.5.0.1-inplace/Reanimate.Builtin.Documentation  module reanimate-1.0.0.0-inplace/Reanimate.Builtin.Documentation 100%6/6
- 0/0 100%117/117
  module reanimate-0.5.0.1-inplace/Reanimate.Builtin.Slide  module reanimate-1.0.0.0-inplace/Reanimate.Builtin.Slide 100%3/3
- 0/0 90%54/60
  module reanimate-0.5.0.1-inplace/Reanimate.Constants  module reanimate-1.0.0.0-inplace/Reanimate.Constants 37%3/8
- 0/0 16%3/18
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Magick  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Magick 0%0/1
- 0/0 0%0/12
  module reanimate-0.5.0.1-inplace/Reanimate.Math.Triangulate  module reanimate-1.0.0.0-inplace/Reanimate.Math.Triangulate 0%0/5
- 0/0 0%0/139
  module reanimate-0.5.0.1-inplace/Reanimate.Parameters  module reanimate-1.0.0.0-inplace/Reanimate.Parameters 15%3/20
- 0/0 14%7/49
  module reanimate-0.5.0.1-inplace/Reanimate.Scene.Core  module reanimate-1.0.0.0-inplace/Reanimate.Scene.Core 66%12/18
- 0/0 72%172/236
  Program Coverage Total
- + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + - + diff --git a/hpc_index_fun.html b/hpc_index_fun.html index 51a3a43..a57114d 100644 --- a/hpc_index_fun.html +++ b/hpc_index_fun.html @@ -7,127 +7,127 @@ table.dashboard { border-collapse: collapse ; border: solid 1px black }
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
  module reanimate-0.5.0.1-inplace/Reanimate.Builtin.Documentation  module reanimate-1.0.0.0-inplace/Reanimate.Builtin.Documentation 100%6/6
- 0/0 100%117/117
  module reanimate-0.5.0.1-inplace/Reanimate.ColorMap  module reanimate-1.0.0.0-inplace/Reanimate.ColorMap 100%14/14
60%3/5
99%1176/1180
  module reanimate-0.5.0.1-inplace/Reanimate.Ease  module reanimate-1.0.0.0-inplace/Reanimate.Ease 87%7/8
100%4/4
96%85/88
  module reanimate-0.5.0.1-inplace/Reanimate.Transition  module reanimate-1.0.0.0-inplace/Reanimate.Transition 100%6/6
50%1/2
95%43/45
  module reanimate-0.5.0.1-inplace/Reanimate.Builtin.Slide  module reanimate-1.0.0.0-inplace/Reanimate.Builtin.Slide 100%3/3
- 0/0 90%54/60
  module reanimate-0.5.0.1-inplace/Reanimate.Animation  module reanimate-1.0.0.0-inplace/Reanimate.Animation 90%28/31
57%8/14
87%298/341
  module reanimate-0.5.0.1-inplace/Reanimate.ColorComponents  module reanimate-1.0.0.0-inplace/Reanimate.ColorComponents 75%9/12
50%1/2
81%135/166
  module reanimate-0.5.0.1-inplace/Reanimate.Scene.Sprite  module reanimate-1.0.0.0-inplace/Reanimate.Scene.Sprite 85%23/27
57%11/19
78%314/400
  module reanimate-0.5.0.1-inplace/Reanimate.Scene.Core  module reanimate-1.0.0.0-inplace/Reanimate.Scene.Core 66%12/18
- 0/0 72%172/236
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.LineCommand  module reanimate-1.0.0.0-inplace/Reanimate.Svg.LineCommand 80%12/15
58%43/74
70%659/937
  module reanimate-0.5.0.1-inplace/Reanimate.Scene.Var  module reanimate-1.0.0.0-inplace/Reanimate.Scene.Var 89%17/19
60%14/23
68%214/313
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.Constructors  module reanimate-1.0.0.0-inplace/Reanimate.Svg.Constructors 67%33/49
37%3/8
65%368/563
  module reanimate-0.5.0.1-inplace/Reanimate.Effect  module reanimate-1.0.0.0-inplace/Reanimate.Effect 52%9/17
66%4/6
53%67/125
  module reanimate-0.5.0.1-inplace/Reanimate.Builtin.Images  module reanimate-1.0.0.0-inplace/Reanimate.Builtin.Images 57%4/7
25%1/4
48%24/49
  module reanimate-0.5.0.1-inplace/Reanimate.Transform  module reanimate-1.0.0.0-inplace/Reanimate.Transform 83%5/6
33%4/12
45%76/166
  module reanimate-0.5.0.1-inplace/Reanimate.Morph.Common  module reanimate-1.0.0.0-inplace/Reanimate.Morph.Common 33%5/15
17%4/23
41%138/329
  module reanimate-0.5.0.1-inplace/Reanimate.Svg  module reanimate-1.0.0.0-inplace/Reanimate.Svg 38%5/13
18%15/80
41%323/777
  module reanimate-0.5.0.1-inplace/Geom2D.CubicBezier.Linear  module reanimate-1.0.0.0-inplace/Geom2D.CubicBezier.Linear 19%20/101
5%2/36
27%97/347
  module reanimate-0.5.0.1-inplace/Reanimate.Morph.Linear  module reanimate-1.0.0.0-inplace/Reanimate.Morph.Linear 40%2/5
16%1/6
26%22/83
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.BoundingBox  module reanimate-1.0.0.0-inplace/Reanimate.Svg.BoundingBox 40%2/5
16%6/36
26%76/282
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.Unuse  module reanimate-1.0.0.0-inplace/Reanimate.Svg.Unuse 33%1/3
0%0/14
22%28/127
  module reanimate-0.5.0.1-inplace/Paths_reanimate  module reanimate-1.0.0.0-inplace/Paths_reanimate 20%3/15
- 0/0 20%12/58
  module reanimate-0.5.0.1-inplace/Reanimate.PolyShape  module reanimate-1.0.0.0-inplace/Reanimate.PolyShape 22%8/35
27%13/48
18%127/691
  module reanimate-0.5.0.1-inplace/Reanimate.Constants  module reanimate-1.0.0.0-inplace/Reanimate.Constants 37%3/8
- 0/0 16%3/18
  module reanimate-0.5.0.1-inplace/Reanimate.Parameters  module reanimate-1.0.0.0-inplace/Reanimate.Parameters 15%3/20
- 0/0 14%7/49
  module reanimate-0.5.0.1-inplace/Reanimate.Raster  module reanimate-1.0.0.0-inplace/Reanimate.Raster 15%2/13
0%0/17
11%52/443
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.CLI  module reanimate-1.0.0.0-inplace/Reanimate.Driver.CLI 13%5/36
0%0/65
7%31/388
  module reanimate-0.5.0.1-inplace/Reanimate.LaTeX  module reanimate-1.0.0.0-inplace/Reanimate.LaTeX 33%4/12
11%1/9
7%12/167
  module reanimate-0.5.0.1-inplace/Reanimate.Render  module reanimate-1.0.0.0-inplace/Reanimate.Render 5%1/19
0%0/53
4%39/852
  module reanimate-0.5.0.1-inplace/Reanimate.Driver  module reanimate-1.0.0.0-inplace/Reanimate.Driver 8%1/12
1%1/55
3%9/245
  module reanimate-0.5.0.1-inplace/Reanimate.Math.Polygon  module reanimate-1.0.0.0-inplace/Reanimate.Math.Polygon 9%8/82
5%4/75
2%59/2409
  module reanimate-0.5.0.1-inplace/Reanimate.Cache  module reanimate-1.0.0.0-inplace/Reanimate.Cache 0%0/8
0%0/12
0%0/160
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Check  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Check 0%0/21
0%0/27
0%0/396
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Compile  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Compile 0%0/2
0%0/4
0%0/64
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Magick  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Magick 0%0/1
- 0/0 0%0/12
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Server  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Server 0%0/17
0%0/30
0%0/625
  module reanimate-0.5.0.1-inplace/Reanimate.Math.Common  module reanimate-1.0.0.0-inplace/Reanimate.Math.Common 0%0/26
0%0/12
0%0/407
  module reanimate-0.5.0.1-inplace/Reanimate.Math.SSSP  module reanimate-1.0.0.0-inplace/Reanimate.Math.SSSP 0%0/19
0%0/53
0%0/909
  module reanimate-0.5.0.1-inplace/Reanimate.Math.Triangulate  module reanimate-1.0.0.0-inplace/Reanimate.Math.Triangulate 0%0/5
- 0/0 0%0/139
  module reanimate-0.5.0.1-inplace/Reanimate.Misc  module reanimate-1.0.0.0-inplace/Reanimate.Misc 0%0/7
0%0/14
0%0/162
  module reanimate-0.5.0.1-inplace/Reanimate.Morph.Cache  module reanimate-1.0.0.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 97144e2..352e2b8 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/LRZe4V6frOI/195.svg","code": "env =\n addStatic (mkBackground \"white\") .\n mapA (withStrokeColor \"black\")\n\nanimation :: Animation\nanimation = env $\n scene $ 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 oTranslateY .= screenBottom+0.5\n oRightX .= screenRight\n botL <- newText \"Bottom left\"\n oModifyS botL $ do\n oTranslateY .= 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 $ oHideWith src oFadeOut\n oShowWith dst oFadeIn\n wait 1\n\nnewText txt =\n newObject $ scale 1.5 $ centerX $ latex txt\n"} ,{"title": "Camera","url": "https://reanimate.clozecards.com/JlWlOpJvDds/150.svg","code": "animation :: Animation\nanimation = docEnv $ mapA (withFillOpacity 1) $ scene $ 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 $ withFillColor \"blue\" $ mkCircle 1\n cameraAttach cam circle\n circleRight <- oRead circle oRightX\n\n box <- newObject $ withFillColor \"green\" $ mkRect 2 2\n cameraAttach cam box\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 (V2 0 0)\n"} ]; -const playgroundVersion = "2020-09-20 (7c879)"; +const playgroundVersion = "2020-09-20 (37aa9)"; diff --git a/reanimate-1.0.0.0-inplace/Geom2D.CubicBezier.Linear.hs.html b/reanimate-1.0.0.0-inplace/Geom2D.CubicBezier.Linear.hs.html new file mode 100644 index 0000000..b70cf26 --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Geom2D.CubicBezier.Linear.hs.html @@ -0,0 +1,366 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE DeriveFoldable         #-}
+    2 {-# LANGUAGE DeriveFunctor          #-}
+    3 {-# LANGUAGE DeriveTraversable      #-}
+    4 {-# LANGUAGE FunctionalDependencies #-}
+    5 {-# LANGUAGE UndecidableInstances   #-}
+    6 {-|
+    7 Module      : Geom2D.CubicBezier.Linear
+    8 Copyright   : Written by David Himmelstrup
+    9 License     : Unlicense
+   10 Maintainer  : lemmih@gmail.com
+   11 Stability   : experimental
+   12 Portability : POSIX
+   13 
+   14 Convenience wrapper around 'Geom2D.CubicBezier'
+   15 
+   16 -}
+   17 module Geom2D.CubicBezier.Linear
+   18   ( AnyBezier(..)
+   19   , CubicBezier(..)
+   20   , QuadBezier(..)
+   21   , OpenPath(..)
+   22   , ClosedPath(..)
+   23   , PathJoin(..)
+   24   , ClosedMetaPath(..)
+   25   , OpenMetaPath(..)
+   26   , MetaJoin(..)
+   27   , MetaNodeType(..)
+   28   , FillRule(..)
+   29   , Tension(..)
+   30   , quadToCubic
+   31   , arcLength
+   32   , arcLengthParam
+   33   , C.splitBezier
+   34   , colinear
+   35   , evalBezier
+   36   , evalBezierDeriv
+   37   , bezierHoriz
+   38   , bezierVert
+   39   , C.bezierSubsegment
+   40   , C.reorient
+   41   , closedPathCurves
+   42   , openPathCurves
+   43   , curvesToClosed
+   44   , closest
+   45   , unmetaOpen
+   46   , unmetaClosed
+   47   , union
+   48   , bezierIntersection
+   49   , interpolateVector
+   50   , vectorDistance
+   51   , findBezierInflection
+   52   , findBezierCusp
+   53   ) where
+   54 
+   55 import qualified Data.Vector.Unboxed as V
+   56 import qualified Geom2D.CubicBezier  as C
+   57 import           Graphics.SvgTree    (FillRule (..))
+   58 import           Linear.V2
+   59 
+   60 ------------------------------------------------------------
+   61 -- Data types
+   62 
+   63 -- | A bezier curve of any degree.
+   64 newtype AnyBezier a = AnyBezier (V.Vector (V2 a))
+   65 
+   66 -- | A cubic bezier curve.
+   67 data CubicBezier a = CubicBezier
+   68   { cubicC0 :: !(V2 a)
+   69   , cubicC1 :: !(V2 a)
+   70   , cubicC2 :: !(V2 a)
+   71   , cubicC3 :: !(V2 a)
+   72   } deriving (Show, Eq)
+   73 
+   74 -- | A quadratic bezier curve.
+   75 data QuadBezier a = QuadBezier
+   76   { quadC0 :: !(V2 a)
+   77   , quadC1 :: !(V2 a)
+   78   , quadC2 :: !(V2 a)
+   79   } deriving (Show, Eq)
+   80 
+   81 -- | Open cubicbezier path.
+   82 data OpenPath a = OpenPath [(V2 a, PathJoin a)] (V2 a)
+   83   deriving (Show, Eq)
+   84 
+   85 -- | Closed cubicbezier path.
+   86 newtype ClosedPath a = ClosedPath [(V2 a, PathJoin a)]
+   87   deriving (Show, Eq)
+   88 
+   89 -- | Join two points with either a straight line or a bezier
+   90 --   curve with two control points.
+   91 data PathJoin a
+   92   = JoinLine
+   93   | JoinCurve (V2 a) (V2 a)
+   94   deriving (Show, Eq)
+   95 
+   96 -- | Closed meta path.
+   97 newtype ClosedMetaPath a = ClosedMetaPath [(V2 a, MetaJoin a)]
+   98   deriving (Show, Eq)
+   99 
+  100 -- | Open meta path
+  101 data OpenMetaPath a = OpenMetaPath [(V2 a, MetaJoin a)] (V2 a)
+  102   deriving (Show, Eq)
+  103 
+  104 -- | The tension value specifies how /tense/ the curve is.
+  105 --   A higher value means the curve approaches a line segment,
+  106 --   while a lower value means the curve is more round. Metafont
+  107 --   doesn't allow values below 3/4.
+  108 data Tension a
+  109   = Tension
+  110     { tensionValue :: a }
+  111   | TensionAtLeast -- ^ Like Tension, but keep the segment inside the
+  112                    --   bounding triangle defined by the control points,
+  113                    --   if there is one.
+  114     { tensionValue :: a }
+  115   deriving (Functor, Foldable, Traversable, Eq, Show)
+  116 
+  117 -- | Join two meta points with either a bezier curve or tension
+  118 --   contraints.
+  119 data MetaJoin a
+  120   = MetaJoin
+  121   { metaTypeL :: MetaNodeType a
+  122   , tensionL  :: Tension a
+  123   , tensionR  :: Tension a
+  124   , metaTypeR :: MetaNodeType a
+  125   }
+  126   | Controls (V2 a) (V2 a)
+  127   deriving (Show, Eq)
+  128 
+  129 -- | Node constraint type.
+  130 data MetaNodeType a
+  131   = Open
+  132   | Curl { curlgamma :: a }
+  133   | Direction { nodedir :: V2 a }
+  134   deriving (Show, Eq)
+  135 
+  136 ------------------------------------------------------------
+  137 -- Methods
+  138 
+  139 -- | Convert a quadratic bezier to a cubic bezier.
+  140 quadToCubic :: Fractional a => QuadBezier a -> CubicBezier a
+  141 quadToCubic = upCast . C.quadToCubic . downCast
+  142 
+  143 -- | @arcLength c t tol@ finds the arclength of the bezier @c@ at @t@,
+  144 --   within given tolerance @tol@.
+  145 arcLength :: CubicBezier Double -> Double -> Double -> Double
+  146 arcLength bezier = C.arcLength (downCast bezier)
+  147 
+  148 -- | @arcLengthParam c len tol@ finds the parameter where the curve @c@
+  149 --   has the arclength @len@, within tolerance @tol@.
+  150 arcLengthParam :: CubicBezier Double -> Double -> Double -> Double
+  151 arcLengthParam bezier = C.arcLengthParam (downCast bezier)
+  152 
+  153 -- | Return @False@ if some points fall outside a line with a thickness of the given tolerance.
+  154 colinear :: CubicBezier Double -> Double -> Bool
+  155 colinear bezier = C.colinear (downCast bezier)
+  156 
+  157 -- | Calculate a value on the bezier curve.
+  158 evalBezier :: (C.GenericBezier b, V.Unbox a, Fractional a) => b a -> a -> V2 a
+  159 evalBezier c p = upCast $ C.evalBezier c p
+  160 
+  161 -- | Calculate a value and the first derivative on the curve.
+  162 evalBezierDeriv :: (V.Unbox a, Fractional a,C.GenericBezier b) => b a -> a -> (V2 a, V2 a)
+  163 evalBezierDeriv c p = upCast $ C.evalBezierDeriv c p
+  164 
+  165 -- | Find the parameter where the bezier curve is horizontal.
+  166 bezierHoriz :: CubicBezier Double -> [Double]
+  167 bezierHoriz = C.bezierHoriz . downCast
+  168 
+  169 -- | Find the parameter where the bezier curve is vertical.
+  170 bezierVert :: CubicBezier Double -> [Double]
+  171 bezierVert = C.bezierVert . downCast
+  172 
+  173 -- | Create a normal path from a metapath.
+  174 unmetaOpen :: OpenMetaPath Double -> OpenPath Double
+  175 unmetaOpen = upCast . C.unmetaOpen . downCast
+  176 
+  177 -- | Create a normal path from a metapath.
+  178 unmetaClosed :: ClosedMetaPath Double -> ClosedPath Double
+  179 unmetaClosed = upCast . C.unmetaClosed . downCast
+  180 
+  181 -- | `O((n+m)*log(n+m))`, for n segments and m intersections.
+  182 --   Union of paths, removing overlap and rounding to the given tolerance.
+  183 union :: [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
+  184 union p fill tol = upCast (C.union (downCast p) (downCast fill) tol)
+  185 
+  186 -- | Find the intersections between two Bezier curves, using the Bezier Clip algorithm.
+  187 --   Returns the parameters for both curves.
+  188 bezierIntersection :: CubicBezier Double -> CubicBezier Double -> Double -> [(Double, Double)]
+  189 bezierIntersection a b = C.bezierIntersection (downCast a) (downCast b)
+  190 
+  191 -- | Find the closest value on the bezier to the given point, within tolerance.
+  192 --   Return the first value found.
+  193 closest :: CubicBezier Double -> V2 Double -> Double -> Double
+  194 closest c p = C.closest (downCast c) (downCast p)
+  195 
+  196 -- | Return the closed path as a list of curves.
+  197 closedPathCurves :: Fractional a => ClosedPath a -> [CubicBezier a]
+  198 closedPathCurves = upCast . C.closedPathCurves . downCast
+  199 
+  200 -- | Return the open path as a list of curves.
+  201 openPathCurves :: Fractional a => OpenPath a -> [CubicBezier a]
+  202 openPathCurves = upCast . C.openPathCurves . downCast
+  203 
+  204 -- | Make an open path from a list of curves. The last control point of each curve is ignored.
+  205 curvesToClosed :: [CubicBezier a] -> ClosedPath a
+  206 curvesToClosed = upCast . C.curvesToClosed . downCast
+  207 
+  208 -- | Interpolate between two vectors.
+  209 interpolateVector :: Num a => V2 a -> V2 a -> a -> V2 a
+  210 interpolateVector a b p = upCast $ C.interpolateVector (downCast a) (downCast b) p
+  211 
+  212 -- | Distance between two vectors.
+  213 vectorDistance :: Floating a => V2 a -> V2 a -> a
+  214 vectorDistance a b = C.vectorDistance (downCast a) (downCast b)
+  215 
+  216 -- | Find inflection points on the curve.
+  217 findBezierInflection :: CubicBezier Double -> [Double]
+  218 findBezierInflection = C.findBezierInflection . downCast
+  219 
+  220 -- | Find the cusps of a bezier.
+  221 findBezierCusp :: CubicBezier Double -> [Double]
+  222 findBezierCusp = C.findBezierCusp . downCast
+  223 
+  224 ------------------------------------------------------------
+  225 -- Instances
+  226 
+  227 instance C.GenericBezier QuadBezier where
+  228   degree = C.degree . downCast
+  229   toVector = C.toVector . downCast
+  230   unsafeFromVector = upCast . C.unsafeFromVector
+  231 
+  232 instance C.GenericBezier CubicBezier where
+  233   degree = C.degree . downCast
+  234   toVector = C.toVector . downCast
+  235   unsafeFromVector = upCast . C.unsafeFromVector
+  236 
+  237 instance C.GenericBezier AnyBezier where
+  238   degree = C.degree . downCast
+  239   toVector = C.toVector . downCast
+  240   unsafeFromVector = upCast . C.unsafeFromVector
+  241 
+  242 ------------------------------------------------------------
+  243 -- Casting
+  244 
+  245 class Cast a b | a -> b, b -> a where
+  246   downCast :: a -> b
+  247   upCast   :: b -> a
+  248 
+  249 instance Cast a b => Cast [a] [b] where
+  250   downCast = map downCast
+  251   upCast = map upCast
+  252 
+  253 instance (Cast a a', Cast b b') => Cast (a,b) (a',b') where
+  254   downCast (a, b) = (downCast a, downCast b)
+  255   upCast (a, b) = (upCast a, upCast b)
+  256 
+  257 instance Cast (V2 a) (C.Point a) where
+  258   downCast (V2 a b) = C.Point a b
+  259   upCast (C.Point a b) = V2 a b
+  260 
+  261 instance Cast FillRule C.FillRule where
+  262   downCast FillEvenOdd = C.EvenOdd
+  263   downCast FillNonZero = C.NonZero
+  264   upCast C.EvenOdd = FillEvenOdd
+  265   upCast C.NonZero = FillNonZero
+  266 
+  267 instance Cast (CubicBezier a) (C.CubicBezier a) where
+  268   downCast (CubicBezier a b c d) = C.CubicBezier
+  269     (downCast a) (downCast b) (downCast c) (downCast d)
+  270   upCast (C.CubicBezier a b c d) = CubicBezier
+  271     (upCast a) (upCast b) (upCast c) (upCast d)
+  272 
+  273 instance Cast (QuadBezier a) (C.QuadBezier a) where
+  274   downCast (QuadBezier a b c) = C.QuadBezier
+  275     (downCast a) (downCast b) (downCast c)
+  276   upCast (C.QuadBezier a b c)= QuadBezier
+  277     (upCast a) (upCast b) (upCast c)
+  278 
+  279 instance V.Unbox a => Cast (AnyBezier a) (C.AnyBezier a) where
+  280   downCast (AnyBezier arr) = C.AnyBezier $
+  281     V.map (\(V2 a b) -> (a,b)) arr
+  282   upCast (C.AnyBezier arr) = AnyBezier $
+  283     V.map (uncurry V2) arr
+  284 
+  285 instance Cast (MetaNodeType a) (C.MetaNodeType a) where
+  286   downCast Open            = C.Open
+  287   downCast (Curl gamma)    = C.Curl gamma
+  288   downCast (Direction dir) = C.Direction (downCast dir)
+  289   upCast C.Open            = Open
+  290   upCast (C.Curl gamma)    = Curl gamma
+  291   upCast (C.Direction dir) = Direction (upCast dir)
+  292 
+  293 instance Cast (Tension a) (C.Tension a) where
+  294   downCast (Tension v)        = C.Tension v
+  295   downCast (TensionAtLeast v) = C.TensionAtLeast v
+  296   upCast (C.Tension v)        = Tension v
+  297   upCast (C.TensionAtLeast v) = TensionAtLeast v
+  298 
+  299 instance Cast (MetaJoin a) (C.MetaJoin a) where
+  300   downCast (MetaJoin tyL tL tR tyR) =
+  301     C.MetaJoin (downCast tyL) (downCast tL) (downCast tR) (downCast tyR)
+  302   downCast (Controls p1 p2) = C.Controls (downCast p1) (downCast p2)
+  303   upCast (C.MetaJoin tyL tL tR tyR) =
+  304     MetaJoin (upCast tyL) (upCast tL) (upCast tR) (upCast tyR)
+  305   upCast (C.Controls p1 p2)         = Controls (upCast p1) (upCast p2)
+  306 
+  307 instance Cast (PathJoin a) (C.PathJoin a) where
+  308   downCast JoinLine        = C.JoinLine
+  309   downCast (JoinCurve a b) = C.JoinCurve (downCast a) (downCast b)
+  310   upCast C.JoinLine        = JoinLine
+  311   upCast (C.JoinCurve a b) = JoinCurve (upCast a) (upCast b)
+  312 
+  313 instance Cast (OpenMetaPath a) (C.OpenMetaPath a) where
+  314   downCast (OpenMetaPath lst end) = C.OpenMetaPath
+  315     [ (downCast p, downCast j)
+  316     | (p, j) <- lst ] (downCast end)
+  317   upCast (C.OpenMetaPath lst end) = OpenMetaPath
+  318     [ (upCast p, upCast j)
+  319     | (p, j) <- lst ] (upCast end)
+  320 
+  321 instance Cast (ClosedMetaPath a) (C.ClosedMetaPath a) where
+  322   downCast (ClosedMetaPath lst) = C.ClosedMetaPath
+  323     [ (downCast p, downCast j)
+  324     | (p, j) <- lst ]
+  325   upCast (C.ClosedMetaPath lst) = ClosedMetaPath
+  326     [ (upCast p, upCast j)
+  327     | (p, j) <- lst ]
+  328 
+  329 instance Cast (OpenPath a) (C.OpenPath a) where
+  330   downCast (OpenPath lst end) = C.OpenPath
+  331     [ (downCast p, downCast j)
+  332     | (p, j) <- lst ] (downCast end)
+  333   upCast (C.OpenPath lst end) = OpenPath
+  334     [ (upCast p, upCast j)
+  335     | (p, j) <- lst ] (upCast end)
+  336 
+  337 instance Cast (ClosedPath a) (C.ClosedPath a) where
+  338   downCast (ClosedPath lst) = C.ClosedPath
+  339     [ (downCast p, downCast j)
+  340     | (p, j) <- lst ]
+  341   upCast (C.ClosedPath lst) = ClosedPath
+  342     [ (upCast p, upCast j)
+  343     | (p, j) <- lst ]
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Paths_reanimate.hs.html b/reanimate-1.0.0.0-inplace/Paths_reanimate.hs.html new file mode 100644 index 0000000..06d1451 --- /dev/null +++ b/reanimate-1.0.0.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 [1,0,0,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-1.0.0.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-1.0.0.0"
+   36 libexecdir = "/home/runner/.cabal/libexec/x86_64-linux-ghc-8.8.3/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Animation.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Animation.hs.html new file mode 100644 index 0000000..87c86ed --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Animation.hs.html @@ -0,0 +1,414 @@ + + + + + + +
+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
+   59 import           Graphics.SvgTree.Printer
+   60 import           Reanimate.Constants
+   61 import           Reanimate.Ease
+   62 import           Reanimate.Svg.Constructors
+   63 import           Text.XML.Light.Output
+   64 
+   65 -- | Duration of an animation or effect. Usually measured in seconds.
+   66 type Duration = Double
+   67 -- | Time signal. Goes from 0 to 1, inclusive.
+   68 type Time = Double
+   69 
+   70 -- | SVG node.
+   71 type SVG = Tree
+   72 
+   73 -- | Animations are SVGs over a finite time.
+   74 data Animation = Animation Duration (Time -> SVG)
+   75 
+   76 -- | Construct an animation with a given duration.
+   77 mkAnimation :: Duration -> (Time -> SVG) -> Animation
+   78 mkAnimation = Animation
+   79 
+   80 -- | Construct an animation with a duration of @1@.
+   81 animate :: (Time -> SVG) -> Animation
+   82 animate = Animation 1
+   83 
+   84 -- | Create an animation with provided @duration@, which consists of stationary frame displayed for its entire duration.
+   85 staticFrame :: Duration -> SVG -> Animation
+   86 staticFrame d svg = Animation d (const svg)
+   87 
+   88 -- | Query the duration of an animation.
+   89 duration :: Animation -> Duration
+   90 duration (Animation d _) = d
+   91 
+   92 -- | Play animations in sequence. The @lhs@ animation is removed after it has
+   93 --   completed. New animation duration is '@duration lhs + duration rhs@'.
+   94 --
+   95 --   Example:
+   96 --
+   97 --   @'Reanimate.Builtin.Documentation.drawBox' `'seqA'` 'Reanimate.Builtin.Documentation.drawCircle'@
+   98 --
+   99 --   <<docs/gifs/doc_seqA.gif>>
+  100 seqA :: Animation -> Animation -> Animation
+  101 seqA (Animation d1 f1) (Animation d2 f2) =
+  102   Animation totalD $ \t ->
+  103     if t < d1/totalD
+  104       then f1 (t * totalD/d1)
+  105       else f2 ((t-d1/totalD) * totalD/d2)
+  106   where
+  107     totalD = d1+d2
+  108 
+  109 -- | Play two animation concurrently. Shortest animation freezes on last frame.
+  110 --   New animation duration is '@max (duration lhs) (duration rhs)@'.
+  111 --
+  112 --   Example:
+  113 --
+  114 --   @'Reanimate.Builtin.Documentation.drawBox' `'parA'` 'adjustDuration' (*2) 'Reanimate.Builtin.Documentation.drawCircle'@
+  115 --
+  116 --   <<docs/gifs/doc_parA.gif>>
+  117 parA :: Animation -> Animation -> Animation
+  118 parA (Animation d1 f1) (Animation d2 f2) =
+  119   Animation (max d1 d2) $ \t ->
+  120     let t1 = t * totalD/d1
+  121         t2 = t * totalD/d2 in
+  122     mkGroup
+  123     [ f1 (min 1 t1)
+  124     , f2 (min 1 t2) ]
+  125   where
+  126     totalD = max d1 d2
+  127 
+  128 -- | Play two animation concurrently. Shortest animation loops.
+  129 --   New animation duration is '@max (duration lhs) (duration rhs)@'.
+  130 --
+  131 --   Example:
+  132 --
+  133 --   @'Reanimate.Builtin.Documentation.drawBox' `'parLoopA'` 'adjustDuration' (*2) 'Reanimate.Builtin.Documentation.drawCircle'@
+  134 --
+  135 --   <<docs/gifs/doc_parLoopA.gif>>
+  136 parLoopA :: Animation -> Animation -> Animation
+  137 parLoopA (Animation d1 f1) (Animation d2 f2) =
+  138   Animation totalD $ \t ->
+  139     let t1 = t * totalD/d1
+  140         t2 = t * totalD/d2 in
+  141     mkGroup
+  142     [ f1 (t1 `mod'` 1)
+  143     , f2 (t2 `mod'` 1) ]
+  144   where
+  145     totalD = max d1 d2
+  146 
+  147 -- | Play two animation concurrently. Animations disappear after playing once.
+  148 --   New animation duration is '@max (duration lhs) (duration rhs)@'.
+  149 --
+  150 --   Example:
+  151 --
+  152 --   @'Reanimate.Builtin.Documentation.drawBox' `'parLoopA'` 'adjustDuration' (*2) 'Reanimate.Builtin.Documentation.drawCircle'@
+  153 --
+  154 --   <<docs/gifs/doc_parDropA.gif>>
+  155 parDropA :: Animation -> Animation -> Animation
+  156 parDropA (Animation d1 f1) (Animation d2 f2) =
+  157   Animation totalD $ \t ->
+  158     let t1 = t * totalD/d1
+  159         t2 = t * totalD/d2 in
+  160     mkGroup
+  161     [ if t1>1 then None else f1 t1
+  162     , if t2>1 then None else f2 t2 ]
+  163   where
+  164     totalD = max d1 d2
+  165 
+  166 -- | Empty animation (no SVG output) with a fixed duration.
+  167 --
+  168 --   Example:
+  169 --
+  170 --   @'pause' 1 `'seqA'` 'Reanimate.Builtin.Documentation.drawProgress'@
+  171 --
+  172 --   <<docs/gifs/doc_pause.gif>>
+  173 pause :: Duration -> Animation
+  174 pause d = Animation d (const None)
+  175 
+  176 -- | Play left animation and freeze on the last frame, then play the right
+  177 --   animation. New duration is '@duration lhs + duration rhs@'.
+  178 --
+  179 --   Example:
+  180 --
+  181 --   @'Reanimate.Builtin.Documentation.drawBox' `'andThen'` 'Reanimate.Builtin.Documentation.drawCircle'@
+  182 --
+  183 --   <<docs/gifs/doc_andThen.gif>>
+  184 andThen :: Animation -> Animation -> Animation
+  185 andThen a b = a `parA` (pause (duration a) `seqA` b)
+  186 
+  187 -- | Calculate the frame that would be displayed at given point in @time@ of running @animation@.
+  188 --
+  189 -- The provided time parameter is clamped between 0 and animation duration.
+  190 frameAt :: Time -> Animation -> SVG
+  191 frameAt t (Animation d f) = f t'
+  192   where
+  193     t' = clamp 0 1 (t/d)
+  194 
+  195 -- | Helper function for pretty-printing SVG nodes.
+  196 renderTree :: SVG -> String
+  197 renderTree t = maybe "" ppElement $ xmlOfTree t
+  198 
+  199 -- | Helper function for pretty-printing SVG nodes as SVG documents.
+  200 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.
+  201           -> Maybe Number -- ^ Similar to previous argument, but for @height@ attribute.
+  202           -> SVG          -- ^ SVG to render
+  203           -> String       -- ^ String representation of SVG XML markup
+  204 renderSvg w h t = ppDocument doc
+  205 -- renderSvg w h t = ppFastElement (xmlOfDocument doc)
+  206   where
+  207     width = 16
+  208     height = 9
+  209     doc = Document
+  210       { _documentViewBox = Just (-width/2, -height/2, width, height)
+  211       , _documentWidth = w
+  212       , _documentHeight = h
+  213       , _documentElements = [withStrokeWidth defaultStrokeWidth $ scaleXY 1 (-1) t]
+  214       , _documentDescription = ""
+  215       , _documentLocation = ""
+  216       , _documentAspectRatio = PreserveAspectRatio False AlignNone Nothing
+  217       }
+  218 
+  219 -- | Map over the SVG produced by an animation at every frame.
+  220 --
+  221 --   Example:
+  222 --
+  223 --   @'mapA' ('scale' 0.5) 'Reanimate.Builtin.Documentation.drawCircle'@
+  224 --
+  225 --   <<docs/gifs/doc_mapA.gif>>
+  226 
+  227 mapA :: (SVG -> SVG) -> Animation -> Animation
+  228 mapA fn (Animation d f) = Animation d (fn . f)
+  229 
+  230 -- | Freeze the last frame for @t@ seconds at the end of the animation.
+  231 --
+  232 --   Example:
+  233 --
+  234 --   @'pauseAtEnd' 1 'Reanimate.Builtin.Documentation.drawProgress'@
+  235 --
+  236 --   <<docs/gifs/doc_pauseAtEnd.gif>>
+  237 pauseAtEnd :: Duration -> Animation -> Animation
+  238 pauseAtEnd t a = a `andThen` pause t
+  239 
+  240 -- | Freeze the first frame for @t@ seconds at the beginning of the animation.
+  241 --
+  242 --   Example:
+  243 --
+  244 --   @'pauseAtBeginning' 1 'Reanimate.Builtin.Documentation.drawProgress'@
+  245 --
+  246 --   <<docs/gifs/doc_pauseAtBeginning.gif>>
+  247 pauseAtBeginning :: Duration -> Animation -> Animation
+  248 pauseAtBeginning t a =
+  249     Animation t (freezeFrame 0 a) `seqA` a
+  250 
+  251 -- | Freeze the first and the last frame of the animation for a specified duration.
+  252 --
+  253 --   Example:
+  254 --
+  255 --   @'pauseAround' 1 1 'Reanimate.Builtin.Documentation.drawProgress'@
+  256 --
+  257 --   <<docs/gifs/doc_pauseAround.gif>>
+  258 pauseAround :: Duration -> Duration -> Animation -> Animation
+  259 pauseAround start end = pauseAtEnd end . pauseAtBeginning start
+  260 
+  261 -- Freeze frame at time @t@.
+  262 freezeFrame :: Time -> Animation -> (Time -> SVG)
+  263 freezeFrame t (Animation d f) = const $ f (t/d)
+  264 
+  265 -- | Change the duration of an animation. Animates are stretched or squished
+  266 --   (rather than truncated) to fit the new duration.
+  267 adjustDuration :: (Duration -> Duration) -> Animation -> Animation
+  268 adjustDuration fn (Animation d gen) =
+  269   Animation (fn d) gen
+  270 
+  271 -- | Set the duration of an animation by adjusting its playback rate. The
+  272 --   animation is still played from start to finish without being cropped.
+  273 setDuration :: Duration -> Animation -> Animation
+  274 setDuration newD = adjustDuration (const newD)
+  275 
+  276 -- | Play an animation in reverse. Duration remains unchanged. Shorthand for:
+  277 --   @'signalA' 'reverseS'@.
+  278 --
+  279 --   Example:
+  280 --
+  281 --   @'reverseA' 'Reanimate.Builtin.Documentation.drawCircle'@
+  282 --
+  283 --   <<docs/gifs/doc_reverseA.gif>>
+  284 reverseA :: Animation -> Animation
+  285 reverseA = signalA reverseS
+  286 
+  287 -- | Play animation before playing it again in reverse. Duration is twice
+  288 --   the duration of the input.
+  289 --
+  290 --   Example:
+  291 --
+  292 --   @'playThenReverseA' 'Reanimate.Builtin.Documentation.drawCircle'@
+  293 --
+  294 --   <<docs/gifs/doc_playThenReverseA.gif>>
+  295 playThenReverseA :: Animation -> Animation
+  296 playThenReverseA a = a `seqA` reverseA a
+  297 
+  298 -- | Loop animation @n@ number of times. This number may be fractional and it
+  299 --   may be less than 1. It must be greater than or equal to 0, though.
+  300 --   New duration is @n*duration input@.
+  301 --
+  302 --   Example:
+  303 --
+  304 --   @'repeatA' 1.5 'Reanimate.Builtin.Documentation.drawCircle'@
+  305 --
+  306 --   <<docs/gifs/doc_repeatA.gif>>
+  307 repeatA :: Double -> Animation -> Animation
+  308 repeatA n (Animation d f) = Animation (d*n) $ \t ->
+  309   f ((t*n) `mod'` 1)
+  310 
+  311 
+  312 -- | @freezeAtPercentage time animation@ creates an animation consisting of stationary frame,
+  313 -- that would be displayed in the provided @animation@ at given @time@.
+  314 -- The duration of the new animation is the same as the duration of provided @animation@.
+  315 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
+  316                    -> Animation -- ^ original animation, from which the frame will be taken
+  317                    -> Animation -- ^ new animation consisting of static frame displayed for the duration of the original animation
+  318 freezeAtPercentage frac (Animation d genFrame) =
+  319   Animation d $ const $ genFrame frac
+  320 
+  321 -- | Overlay animation on top of static SVG image.
+  322 --
+  323 --  Example:
+  324 --
+  325 --  @'addStatic' ('mkBackground' "lightblue") 'Reanimate.Builtin.Documentation.drawCircle'@
+  326 --
+  327 --  <<docs/gifs/doc_addStatic.gif>>
+  328 addStatic :: SVG -> Animation -> Animation
+  329 addStatic static = mapA (\frame -> mkGroup [static, frame])
+  330 
+  331 -- | Modify the time component of an animation. Animation duration is unchanged.
+  332 --
+  333 --   Example:
+  334 --
+  335 --   @'signalA' ('fromToS' 0.25 0.75) 'Reanimate.Builtin.Documentation.drawCircle'@
+  336 --
+  337 --   <<docs/gifs/doc_signalA.gif>>
+  338 signalA :: Signal -> Animation -> Animation
+  339 signalA fn (Animation d gen) = Animation d $ gen . fn
+  340 
+  341 -- | @takeA duration animation@ creates a new animation consisting of initial segment of
+  342 --   @animation@ of given @duration@, played at the same rate as the original animation.
+  343 --
+  344 --  The @duration@ parameter is clamped to be between 0 and @animation@'s duration.
+  345 --  New animation duration is equal to (eventually clamped) @duration@.
+  346 takeA :: Duration -> Animation -> Animation
+  347 takeA len (Animation d gen) = Animation len' $ \t ->
+  348     gen (t * len'/d)
+  349   where
+  350     len' = clamp 0 d len
+  351 
+  352 -- | @dropA duration animation@ creates a new animation by dropping initial segment
+  353 --   of length @duration@ from the provided @animation@, played at the same rate as the original animation.
+  354 --
+  355 --  The @duration@ parameter is clamped to be between 0 and @animation@'s duration.
+  356 --  The duration of the resulting animation is duration of provided @animation@ minus (eventually clamped) @duration@.
+  357 dropA :: Duration -> Animation -> Animation
+  358 dropA len (Animation d gen) = Animation len' $ \t ->
+  359     gen (t * len'/d + len/d)
+  360   where
+  361     len' = d - clamp 0 d len
+  362 
+  363 -- | @lastA duration animation@ return the last @duration@ seconds of the animation.
+  364 lastA :: Duration -> Animation -> Animation
+  365 lastA len a = dropA (duration a - len) a
+  366 
+  367 clamp :: Double -> Double -> Double -> Double
+  368 clamp a b number
+  369   | a < b     = max a (min b number)
+  370   | otherwise = max b (min a number)
+  371 
+  372 -- (#) :: a -> (a -> b) -> b
+  373 -- o # f = f o
+  374 
+  375 -- | Ask for an animation frame using a given synchronization policy.
+  376 getAnimationFrame :: Sync -> Animation -> Time -> Duration -> SVG
+  377 getAnimationFrame sync (Animation aDur aGen) t d =
+  378   case sync of
+  379     SyncStretch -> aGen (t/d)
+  380     SyncLoop    -> aGen (takeFrac $ t/aDur)
+  381     SyncDrop    -> if t > aDur then None else aGen (t/aDur)
+  382     SyncFreeze  -> aGen (min 1 $ t/aDur)
+  383   where
+  384     takeFrac f = snd (properFraction f :: (Int, Double))
+  385 
+  386 -- | Animation synchronization policies.
+  387 data Sync
+  388   = SyncStretch
+  389   | SyncLoop
+  390   | SyncDrop
+  391   | SyncFreeze
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Builtin.Documentation.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Builtin.Documentation.hs.html new file mode 100644 index 0000000..d6a0692 --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Builtin.Images.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Builtin.Images.hs.html new file mode 100644 index 0000000..5be7e8b --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Builtin.Slide.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Builtin.Slide.hs.html new file mode 100644 index 0000000..9e8a6c2 --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Cache.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Cache.hs.html new file mode 100644 index 0000000..2690749 --- /dev/null +++ b/reanimate-1.0.0.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, pattern None)
+   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 svg
+  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-1.0.0.0-inplace/Reanimate.ColorComponents.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.ColorComponents.hs.html new file mode 100644 index 0000000..3256f3c --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.ColorMap.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.ColorMap.hs.html new file mode 100644 index 0000000..bd99486 --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Constants.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Constants.hs.html new file mode 100644 index 0000000..146a989 --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Driver.CLI.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Driver.CLI.hs.html new file mode 100644 index 0000000..3281f5e --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Driver.CLI.hs.html @@ -0,0 +1,251 @@ + + + + + + +
+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     , renderHash    :: Bool
+   48     }
+   49    deriving (Show)
+   50 
+   51 data Preset = Youtube | ExampleGif | Quick | MediumQ | HighQ | LowFPS
+   52   deriving (Show)
+   53 
+   54 readRaster :: String -> Maybe Raster
+   55 readRaster raster =
+   56   case map toLower raster of
+   57     "none"          -> Just RasterNone
+   58     "auto"          -> Just RasterAuto
+   59     "inkscape"      -> Just RasterInkscape
+   60     "rsvg"          -> Just RasterRSvg
+   61     "imagemagick"   -> Just RasterMagick
+   62     _               -> Nothing
+   63 
+   64 showRaster :: Raster -> String
+   65 showRaster RasterNone     = "none"
+   66 showRaster RasterAuto     = "auto"
+   67 showRaster RasterInkscape = "inkscape"
+   68 showRaster RasterRSvg     = "rsvg"
+   69 showRaster RasterMagick   = "imagemagick"
+   70 
+   71 readFormat :: String -> Maybe Format
+   72 readFormat fmt =
+   73   case map toLower fmt of
+   74     "mp4"  -> Just RenderMp4
+   75     "gif"  -> Just RenderGif
+   76     "webm" -> Just RenderWebm
+   77     _      -> Nothing
+   78 
+   79 showFormat :: Format -> String
+   80 showFormat RenderMp4  = "mp4"
+   81 showFormat RenderGif  = "gif"
+   82 showFormat RenderWebm = "webm"
+   83 
+   84 readPreset :: String -> Maybe Preset
+   85 readPreset preset =
+   86   case map toLower preset of
+   87     "youtube" -> Just Youtube
+   88     "gif"     -> Just ExampleGif
+   89     "quick"   -> Just Quick
+   90     "medium"  -> Just MediumQ
+   91     "high"    -> Just HighQ
+   92     "lowfps"  -> Just LowFPS
+   93     _         -> Nothing
+   94 
+   95 showPreset :: Preset -> String
+   96 showPreset Youtube    = "youtube"
+   97 showPreset ExampleGif = "gif"
+   98 showPreset Quick      = "quick"
+   99 showPreset MediumQ    = "medium"
+  100 showPreset HighQ      = "high"
+  101 showPreset LowFPS     = "lowfps"
+  102 
+  103 options :: Parser Options
+  104 options = Options <$> commandP
+  105 
+  106 commandP :: Parser Command
+  107 commandP = subparser(
+  108      command "test" testCommand
+  109   <> commandGroup "Internal commands"
+  110   <> internal )
+  111   <|> hsubparser
+  112     ( command "check" checkCommand
+  113     <> command "view" viewCommand
+  114     <> command "render" renderCommand
+  115     <> command "raw" rawCommand
+  116     )
+  117   <|> infoParser viewCommand
+  118 
+  119 rawCommand :: ParserInfo Command
+  120 rawCommand = info parse
+  121     (progDesc "Output raw SVGs for animation at 60 fps. Used internally by viewer.")
+  122   where
+  123     parse = Raw
+  124       <$> strOption
+  125         ( long "output" <>
+  126           short 'o' <>
+  127           metavar "PATH" <>
+  128           help "Output folder" <>
+  129           value ".")
+  130       <*> option auto
+  131         ( long "offset" <>
+  132           metavar "NUMBER" <>
+  133           help "Frame offset" <>
+  134           value 0)
+  135       <*> switch
+  136         ( long "pretty-print" <>
+  137           short 'p' <>
+  138           help "Pretty print svg")
+  139 
+  140 testCommand :: ParserInfo Command
+  141 testCommand = info (parse <**> helper)
+  142     (progDesc "Generate 10 frames spread out evenly across the animation. Used \
+  143               \internally by the test-suite.")
+  144   where
+  145     parse = pure Test
+  146 
+  147 checkCommand :: ParserInfo Command
+  148 checkCommand = info parse
+  149     (progDesc "Run a system's diagnostic and report any missing external dependencies.")
+  150   where
+  151     parse = pure Check
+  152 
+  153 viewCommand :: ParserInfo Command
+  154 viewCommand = info parse
+  155     (progDesc "Play animation in browser window.")
+  156   where
+  157     parse = View
+  158       <$> switch
+  159         (long "verbose" <> short 'v')
+  160       <*> optional (strOption (long "ghc"
+  161                     <> metavar "PATH"
+  162                     <> help "Path to GHC binary"))
+  163       <*> many (strOption (long "ghc-opt"
+  164                 <> short 'G'
+  165                 <> help "Additional option to pass to ghc"))
+  166       <*> optional (strOption (long "self"
+  167                     <> metavar "PATH"
+  168                     <> help "Source file used for live-reloading"))
+  169 
+  170 renderCommand :: ParserInfo Command
+  171 renderCommand = info parse
+  172     (progDesc "Render animation to file.")
+  173   where
+  174     -- fromPreset :: (Maybe Preset -> (Command -> Command))
+  175     -- fromPreset Nothing = id
+  176     -- fromPreset (Just ExampleGif) = \cmd -> cmd{renderFPS=24}
+  177     -- modParser :: Parser (Command -> Command)
+  178     -- modParser = fmap fromPreset $
+  179     --   optional (option (maybeReader readPreset)
+  180     --       (long "preset" <> showDefaultWith showPreset
+  181     --       <> metavar "TYPE"
+  182     --       <> help "Parameter presets: youtube, gif, quick"))
+  183     parse = Render
+  184       <$> optional (strOption (long "target"
+  185                     <> short 'o'
+  186                     <> metavar "FILE"
+  187                     <> help "Write output to FILE"))
+  188       <*> optional (option auto
+  189           (long "fps" <> metavar "FPS"
+  190           <> help "Set frames per second."))
+  191       <*> optional (option auto
+  192           (long "width" <> short 'w' <> metavar "PIXELS"
+  193           <> help "Set video width."))
+  194       <*> optional (option auto
+  195           (long "height" <> short 'h'
+  196           <> metavar "PIXELS" <> help "Set video height."))
+  197       <*> switch (long "compile"
+  198                   <> help "Compile source code before rendering.")
+  199       <*> optional (option (maybeReader readFormat)
+  200           (long "format" <> metavar "FMT"
+  201           <> help "Video format: mp4, gif, webm"))
+  202       <*> optional (option (maybeReader readPreset)
+  203           (long "preset" <> showDefaultWith showPreset
+  204           <> metavar "TYPE"
+  205           <> help "Parameter presets: youtube, gif, quick, medium, high"))
+  206       <*> option (maybeReader readRaster)
+  207           (long "raster" <> showDefaultWith showRaster
+  208           <> metavar "RASTER"
+  209           <> value RasterNone
+  210           <> help "Raster engine: none, auto, inkscape, rsvg, imagemagick")
+  211       <*> switch
+  212         (long "partial"
+  213         <> help "Produce partial animation even if frame generation was \
+  214                 \interrupted by ctrl-c")
+  215       <*> flag True False
+  216         (long "disable-hashing"
+  217         <> help "Disable SVG dedup via hashing. This might improve performance \
+  218                 \if all your frames are unique.")
+  219 
+  220 opts :: ParserInfo Options
+  221 opts = info (options <**> helper )
+  222   ( fullDesc
+  223   <> progDesc "This program contains an animation which can either be viewed \
+  224               \in a web-browser or rendered to disk."
+  225   )
+  226 
+  227 getDriverOptions :: IO Options
+  228 getDriverOptions = customExecParser (prefs showHelpOnError) opts
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Driver.Check.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Driver.Check.hs.html new file mode 100644 index 0000000..11d56c6 --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Driver.Compile.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Driver.Compile.hs.html new file mode 100644 index 0000000..131765a --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Driver.Magick.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Driver.Magick.hs.html new file mode 100644 index 0000000..110422b --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Driver.Magick.hs.html @@ -0,0 +1,42 @@ + + + + + + +
+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 {-# NOINLINE magickCmd #-}
+    9 -- |The name of the ImageMagick command. On Unix-like operating systems, the
+   10 -- command \'convert\' does not conflict with the name of other commands. On
+   11 -- Windows, ImageMagick version 7 is readily available, the command \'magick\'
+   12 -- should be present, and is preferred over \'convert\'. If it is not present,
+   13 -- \'convert\' is assumed to be the relevant command.
+   14 magickCmd :: String
+   15 -- The use of 'unsafeperformIO' is justified on the basis that if \'magick\' is
+   16 -- found once, it will always be present.
+   17 magickCmd = unsafePerformIO $ do
+   18   mPath <- findExecutable "magick"
+   19   pure $ maybe "convert" (const "magick") mPath
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Driver.Server.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Driver.Server.hs.html new file mode 100644 index 0000000..634e70a --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Driver.Server.hs.html @@ -0,0 +1,323 @@ + + + + + + +
+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
+  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           raiseError conn err
+  181         Right (frameNumber, "") ->
+  182           pure frameNumber
+  183         Right {} -> do
+  184           let err = "Unexpected output"
+  185           hPutStrLn stderr (T.unpack frame)
+  186           raiseError conn err
+  187 
+  188 raiseError :: Connection -> String -> IO a
+  189 raiseError conn err = do
+  190   hPutStrLn stderr $ "expectFrame: " ++ err
+  191   sendWebMessage conn $ WebError err
+  192   exitWith (ExitFailure 1)
+  193 
+  194 watchFile :: WatchManager -> FilePath -> IO () -> IO StopListening
+  195 watchFile watch file action = watchTree watch (takeDirectory file) check (const action)
+  196   where
+  197     check event =
+  198       takeFileName (eventPath event) == takeFileName file ||
+  199       takeExtension (eventPath event) `elem` sourceExtensions ||
+  200       takeExtension (eventPath event) `elem` dataExtensions
+  201     sourceExtensions = [".hs", ".lhs"]
+  202     dataExtensions = [".jpg", ".png", ".bmp", ".pov", ".tex", ".csv"]
+  203 
+  204 ghcOptions :: FilePath -> [String]
+  205 ghcOptions tmpDir =
+  206     ["-rtsopts", "--make", "-threaded", "-O2"] ++
+  207     ["-odir", tmpDir, "-hidir", tmpDir]
+  208 
+  209 -- FIXME: Move to a different module
+  210 requireOwnSource :: IO FilePath
+  211 requireOwnSource = do
+  212   mbSelf <- findOwnSource
+  213   case mbSelf of
+  214     Nothing -> do
+  215       hPutStrLn stderr
+  216         "Rendering in browser window is only available when interpreting.\n\
+  217         \To render a video file, use the 'render' command or run again with --help\n\
+  218         \to see all available options."
+  219       exitFailure
+  220     Just self -> pure self
+  221 
+  222 findOwnSource :: IO (Maybe FilePath)
+  223 findOwnSource = do
+  224   fullArgs <- getFullArgs
+  225   stackSource <- makeAbsolute (last fullArgs)
+  226   exist <- doesFileExist stackSource
+  227   if exist && isHaskellFile stackSource
+  228     then return (Just stackSource)
+  229     else do
+  230       prog <- getProgName
+  231       let hsProg
+  232             | isHaskellFile prog = prog
+  233             | otherwise = replaceExtension prog "hs"
+  234       lst <- listDirectory "."
+  235       findFile ("." : lst) hsProg
+  236 
+  237 isHaskellFile :: FilePath -> Bool
+  238 isHaskellFile path = takeExtension path `elem` [".hs", ".lhs"]
+  239 
+  240 logMsg :: String -> IO ()
+  241 logMsg msg = do
+  242     now <- getCurrentTime
+  243     putStrLn $ formatTime defaultTimeLocale fmt now ++ ": " ++ msg
+  244   where
+  245     fmt = "%F %T%2Q"
+  246 
+  247 -------------------------------------------------------------------------------
+  248 -- Ghci interface
+  249 
+  250 -- stack
+  251 -- cabal
+  252 -- raw
+  253 -- none?
+  254 newtype GhciBackend = GhciBackend (MVar Ghci)
+  255 
+  256 ghciBackend :: Maybe FilePath -> FilePath -> IO GhciBackend
+  257 ghciBackend mbGHCPath self = do
+  258   let ghciProc =
+  259         case mbGHCPath of
+  260           Just ghcPath ->
+  261             proc ghcPath $ ["--interactive", "+RTS"] ++ words memoryLimit ++ ["-RTS"]
+  262           Nothing ->
+  263             proc "stack" ["exec", "ghci", "--rts-options="++memoryLimit]
+  264   (ghci, _loads) <- startGhciProcess ghciProc $ \_stream _msg -> return ()
+  265   void $ exec ghci $ ":load " ++ self
+  266   ref <- newMVar ghci
+  267   return $ GhciBackend ref
+  268 
+  269 ghciReload :: GhciBackend -> IO ()
+  270 ghciReload (GhciBackend ref) =
+  271   withMVar ref $ \ghci ->
+  272     void $ reload ghci
+  273 
+  274 ghciGenerate :: GhciBackend -> FilePath -> (Int -> IO ()) -> IO ()
+  275 ghciGenerate (GhciBackend ref) target cb = withMVar ref $ \ghci ->
+  276   execStream ghci (":main raw --output=" ++ target ++ " --offset=1")
+  277     $ \_ msg ->
+  278       case reads msg of
+  279         [(frameIdx,"")] -> cb frameIdx
+  280         _               -> return ()
+  281 
+  282 memoryLimit :: String
+  283 memoryLimit = "-M1G"
+  284 
+  285 -------------------------------------------------------------------------------
+  286 -- Websocket API
+  287 
+  288 data WebMessage
+  289   = WebStatus String
+  290   | WebError String
+  291   | WebFrameCount Int
+  292   | WebFrame Int FilePath
+  293 
+  294 sendWebMessage :: Connection -> WebMessage -> IO ()
+  295 sendWebMessage conn msg = sendTextData conn $
+  296   case msg of
+  297     WebStatus txt   -> T.pack "status\n" <> T.pack txt
+  298     WebError txt    -> T.pack "error\n" <> T.pack txt
+  299     WebFrameCount n -> T.pack $ "frame_count\n" ++ show n
+  300     WebFrame n path -> T.pack $ "frame\n" ++ show n ++ "\n" ++ path
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Driver.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Driver.hs.html new file mode 100644 index 0000000..9146644 --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Ease.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Ease.hs.html new file mode 100644 index 0000000..febff54 --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Ease.hs.html @@ -0,0 +1,147 @@ + + + + + + +
+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 -- @
+   26 -- 'Reanimate.signalA' ('constantS' 0.5) 'Reanimate.Builtin.Documentation.drawProgress'
+   27 -- @
+   28 --
+   29 --   <<docs/gifs/doc_constantS.gif>>
+   30 constantS :: Double -> Signal
+   31 constantS = const
+   32 
+   33 -- | Signal with new starting and end values.
+   34 --
+   35 --   Example:
+   36 --
+   37 -- @
+   38 -- 'Reanimate.signalA' ('fromToS' 0.8 0.2) 'Reanimate.Builtin.Documentation.drawProgress'
+   39 -- @
+   40 --
+   41 --   <<docs/gifs/doc_fromToS.gif>>
+   42 fromToS :: Double -> Double -> Signal
+   43 fromToS from to t = from + (to-from)*t
+   44 
+   45 -- | Reverse signal order.
+   46 --
+   47 --   Example:
+   48 --
+   49 -- @
+   50 -- 'Reanimate.signalA' 'reverseS' 'Reanimate.Builtin.Documentation.drawProgress'
+   51 -- @
+   52 --
+   53 --   <<docs/gifs/doc_reverseS.gif>>
+   54 reverseS :: Signal
+   55 reverseS t = 1-t
+   56 
+   57 -- | S-curve signal. Takes a steepness parameter. 2 is a good default.
+   58 --
+   59 --   Example:
+   60 --
+   61 -- @
+   62 -- 'Reanimate.signalA' ('curveS' 2) 'Reanimate.Builtin.Documentation.drawProgress'
+   63 -- @
+   64 --
+   65 --   <<docs/gifs/doc_curveS.gif>>
+   66 curveS :: Double -> Signal
+   67 curveS steepness s =
+   68   if s < 0.5
+   69     then 0.5 * (2*s)**steepness
+   70     else 1-0.5 * (2 - 2*s)**steepness
+   71 
+   72 -- | Power curve signal. Takes a steepness parameter. 2 is a good default.
+   73 --
+   74 --   Example:
+   75 --
+   76 -- @
+   77 -- 'Reanimate.signalA' ('powerS' 2) 'Reanimate.Builtin.Documentation.drawProgress'
+   78 -- @
+   79 --
+   80 --   <<docs/gifs/doc_powerS.gif>>
+   81 powerS :: Double -> Signal
+   82 powerS steepness s = s**steepness
+   83 
+   84 -- | Oscillate signal.
+   85 --
+   86 --   Example:
+   87 --
+   88 -- @
+   89 -- 'Reanimate.signalA' 'oscillateS' 'Reanimate.Builtin.Documentation.drawProgress'
+   90 -- @
+   91 --
+   92 --   <<docs/gifs/doc_oscillateS.gif>>
+   93 oscillateS :: Signal
+   94 oscillateS t =
+   95   if t < 1/2
+   96     then t*2
+   97     else 2-t*2
+   98 
+   99 -- | Bell-curve signal. Takes a steepness parameter. 2 is a good default.
+  100 --
+  101 --   Example:
+  102 --
+  103 -- @
+  104 -- 'Reanimate.signalA' ('bellS' 2) 'Reanimate.Builtin.Documentation.drawProgress'
+  105 -- @
+  106 --
+  107 --   <<docs/gifs/doc_bellS.gif>>
+  108 bellS :: Double -> Signal
+  109 bellS steepness = curveS steepness . oscillateS
+  110 
+  111 -- | Cubic Bezier signal. Gives you a fair amount of control over how the
+  112 --   signal will curve.
+  113 --
+  114 --   Example:
+  115 --
+  116 -- @
+  117 -- 'Reanimate.signalA' ('cubicBezierS' (0.0, 0.8, 0.9, 1.0)) 'Reanimate.Builtin.Documentation.drawProgress'
+  118 -- @
+  119 --   
+  120 --   <<docs/gifs/doc_cubicBezierS.gif>>
+  121 cubicBezierS :: (Double, Double, Double, Double) -> Signal
+  122 cubicBezierS (x1, x2, x3, x4) s = 
+  123   let ms = 1-s
+  124   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-1.0.0.0-inplace/Reanimate.Effect.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Effect.hs.html new file mode 100644 index 0000000..be63805 --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.LaTeX.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.LaTeX.hs.html new file mode 100644 index 0000000..47961ac --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Math.Common.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Math.Common.hs.html new file mode 100644 index 0000000..790c90b --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Math.Polygon.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Math.Polygon.hs.html new file mode 100644 index 0000000..2466385 --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Math.Polygon.hs.html @@ -0,0 +1,803 @@ + + + + + + +
+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   -- * Built-in shapes for testing
+   53   , triangle  -- :: Polygon
+   54   , triangle' -- :: [P]
+   55   , shape1  -- :: Polygon
+   56   , shape2  -- :: Polygon
+   57   , shape3  -- :: Polygon
+   58   , shape4  -- :: Polygon
+   59   , shape5  -- :: Polygon
+   60   , shape6  -- :: Polygon
+   61   , shape7  -- :: Polygon
+   62   , shape8  -- :: Polygon
+   63   , shape9  -- :: Polygon
+   64   , shape10 -- :: Polygon
+   65   , shape11 -- :: Polygon
+   66   , shape12 -- :: Polygon
+   67   , shape13 -- :: Polygon
+   68   , shape14 -- :: Polygon
+   69   , shape15 -- :: Polygon
+   70   , shape16 -- :: Polygon
+   71   , shape17 -- :: Polygon
+   72   , shape18 -- :: Polygon
+   73   , shape19 -- :: Polygon
+   74   , shape20 -- :: Polygon
+   75   , shape21 -- :: Polygon
+   76   , shape22 -- :: Polygon
+   77   , shape23 -- :: Polygon
+   78   , concave -- :: Polygon
+   79   -- * Internals
+   80   , pRing       -- :: APolygon a -> Ring a
+   81   , pUnsafeMap  -- :: (Ring a -> Ring a) -> APolygon a -> APolygon a
+   82   , pCopy       -- :: Polygon -> Polygon
+   83   , pGenerate   -- :: [(Double, Double)] -> Polygon
+   84   , pUnGenerate -- :: Polygon -> [(Double, Double)]
+   85   , Epsilon
+   86   ) where
+   87 
+   88 -- import           Control.Exception
+   89 import           Data.Hashable
+   90 import           Data.List                  (intersect, maximumBy, sort, sortOn,
+   91                                              tails)
+   92 import           Data.Maybe
+   93 import           Data.Ratio
+   94 import           Data.Serialize
+   95 import           Data.Vector                (Vector)
+   96 import qualified Data.Vector                as V
+   97 import           Linear.V2
+   98 import           Linear.Vector
+   99 import           Reanimate.Math.Common
+  100 -- import           Reanimate.Math.EarClip
+  101 import           Reanimate.Math.SSSP
+  102 import           Reanimate.Math.Triangulate
+  103 
+  104 -- import Debug.Trace
+  105 
+  106 -- Generate random polygons, options:
+  107 --   1. put corners around a circle. Vary the radius.
+  108 --   2. close a hilbert curve
+  109 type FPolygon = APolygon Double
+  110 -- Optimize representation?
+  111 --   Polygon = (Vector XNumerator, Vector XDenominator
+  112 --             ,Vector YNumerator, Vector YDenominator)
+  113 data APolygon a = Polygon
+  114   { polygonPoints        :: Vector (V2 a)
+  115   , polygonOffset        :: Int
+  116   , polygonTriangulation :: Triangulation
+  117   , polygonSSSP          :: Vector SSSP
+  118   }
+  119 type Polygon = APolygon Rational
+  120 type P = V2 Double
+  121 
+  122 instance Show a => Show (APolygon a) where
+  123   show = show . V.toList . polygonPoints
+  124 
+  125 instance Hashable a => Hashable (APolygon a) where
+  126   hashWithSalt s p = V.foldl' hashWithSalt s (polygonPoints p)
+  127 
+  128 instance (PolyCtx a, Serialize a) => Serialize (APolygon a) where
+  129   put = put . V.toList . polygonPoints
+  130   get = mkPolygon . V.fromList <$> get
+  131 
+  132 pRing :: APolygon a -> Ring a
+  133 pRing = ringPack . polygonPoints
+  134 
+  135 type PolyCtx a = (Real a, Fractional a, Epsilon a)
+  136 
+  137 mkPolygon :: PolyCtx a => V.Vector (V2 a) -> APolygon a
+  138 mkPolygon points = Polygon
+  139     { polygonPoints = points
+  140     , polygonOffset = 0
+  141     , polygonTriangulation = trig
+  142     , polygonSSSP = V.generate n $ \i -> sssp ring (dual i trig)
+  143     }
+  144   where
+  145     n = length points
+  146     ring = ringPack points
+  147     trig = triangulate ring
+  148       -- earClip ring
+  149 
+  150 castPolygon :: (PolyCtx a, PolyCtx b) => APolygon a -> APolygon b
+  151 castPolygon = mkPolygon . V.map (fmap realToFrac) . polygonPoints
+  152 
+  153 mkPolygonFromRing :: PolyCtx a => Ring a -> APolygon a
+  154 mkPolygonFromRing = mkPolygon . ringUnpack
+  155 
+  156 pUnsafeMap :: (Ring a -> Ring a) -> APolygon a -> APolygon a
+  157 pUnsafeMap fn p = p{ polygonPoints = ringUnpack (fn (pRing p)) }
+  158 
+  159 -- pParent p i j = shortest-path parent from j to i
+  160 pParent :: APolygon a -> Int -> Int -> Int
+  161 pParent p i j =
+  162     (sTree V.! mod (j + polygonOffset p) n - polygonOffset p) `mod` n
+  163   where
+  164     sTree = polygonSSSP p V.! mod (i + polygonOffset p) n
+  165     n = pSize p
+  166 
+  167 pCopy :: Polygon -> Polygon
+  168 pCopy p = mkPolygon $ V.generate (pSize p) $ pAccess p
+  169 
+  170 pSetOffset :: APolygon a -> Int -> APolygon a
+  171 pSetOffset p offset =
+  172   p { polygonOffset = offset `mod` pSize p }
+  173 
+  174 pAdjustOffset :: APolygon a -> Int -> APolygon a
+  175 pAdjustOffset p offset =
+  176   p { polygonOffset = (polygonOffset p + offset) `mod` pSize p }
+  177 
+  178 {-# INLINE pSize #-}
+  179 pSize :: APolygon a -> Int
+  180 pSize = length . polygonPoints
+  181 
+  182 pNull :: APolygon a -> Bool
+  183 pNull = V.null . polygonPoints
+  184 
+  185 pNext :: APolygon a -> Int -> Int
+  186 pNext p i = (i+1) `mod` pSize p
+  187 
+  188 pPrev :: APolygon a -> Int -> Int
+  189 pPrev p i = (i-1) `mod` pSize p
+  190 
+  191 -- When is a polygon valid/simple?
+  192 --   It is counter-clockwise.
+  193 --   No edges intersect.
+  194 -- O(n^2)
+  195 -- 'checkEdge' takes 90% of the time.
+  196 pIsSimple :: Polygon -> Bool
+  197 pIsSimple p | pSize p < 3 = False
+  198 pIsSimple p = pIsCCW p && noDups && checkEdge 0 2
+  199   where
+  200     noDups = checkForDups (sort (V.toList (polygonPoints p)))
+  201     checkForDups (x:y:xs)
+  202       = x /= y && checkForDups (y:xs)
+  203     checkForDups _ = True
+  204     len = pSize p
+  205     -- check i,i+1 against j,j+1
+  206     -- j > i+1
+  207     checkEdge i j
+  208       | j >= len = (i > len-3) || checkEdge (i+1) (i+3)
+  209       | otherwise =
+  210         case lineIntersect (pAccess p i, pAccess p $ i+1)
+  211                            (pAccess p j, pAccess p $ j+1) of
+  212           Just u | u /= pAccess p i -> False
+  213           _nothing                  -> checkEdge i (j+1)
+  214 
+  215 pScale :: Rational -> Polygon -> Polygon
+  216 pScale s = pUnsafeMap (ringMap (^* s))
+  217 
+  218 pAtCentroid :: Polygon -> Polygon
+  219 pAtCentroid p = pTranslate (negate c) p
+  220   where c = pCentroid p ^/ 2
+  221 
+  222 pAtCenter :: Polygon -> Polygon
+  223 pAtCenter p = pTranslate (negate $ pCenter p) p
+  224 
+  225 pTranslate :: V2 Rational -> Polygon -> Polygon
+  226 pTranslate v = pUnsafeMap (ringMap (+v))
+  227 
+  228 pCenter :: Polygon -> V2 Rational
+  229 pCenter p = V2 (x+w/2) (y+h/2)
+  230   where
+  231     (x,y,w,h) = pBoundingBox p
+  232 
+  233 -- Returns (min-x, min-y, width, height)
+  234 pBoundingBox :: Polygon -> (Rational, Rational, Rational, Rational)
+  235 pBoundingBox = \p ->
+  236     let V2 x y = pAccess p 0 in
+  237     case V.foldl' worker (x, y, 0, 0) (polygonPoints p) of
+  238       (xMin, yMin, xMax, yMax) ->
+  239         (xMin, yMin, xMax-xMin, yMax-yMin)
+  240   where
+  241     worker (xMin,yMin,xMax,yMax) (V2 thisX thisY) =
+  242       (min xMin thisX, min yMin thisY
+  243       ,max xMax thisX, max yMax thisY)
+  244 
+  245 -- Place n points on a circle, use one parameter to slide the points back and forth.
+  246 -- Use second parameter to move points closer to center circle.
+  247 pGenerate :: [(Double, Double)] -> Polygon
+  248 pGenerate points
+  249   | len < 4 = error "pGenerate: require at least four points"
+  250   | otherwise = mkPolygon $ V.fromList
+  251   [ V2 (realToFrac $ cos ang * rMod)
+  252        (realToFrac $ sin ang * rMod)
+  253   | (i,(angMod,rMod))  <- zip [0..] points
+  254   , let minAngle = tau / len * i - pi
+  255         maxAngle = tau / len * (i+1) - pi
+  256         ang = minAngle + (maxAngle-minAngle)*angMod
+  257   ]
+  258   where
+  259     tau = 2*pi
+  260     len = fromIntegral (length points)
+  261 
+  262 pUnGenerate :: Polygon -> [(Double, Double)]
+  263 pUnGenerate p =
+  264     [ worker i (fmap realToFrac e)
+  265     | (i,e) <- zip [0..] (V.toList $ polygonPoints p) ]
+  266   where
+  267     len = fromIntegral (pSize p)
+  268     worker i (V2 x y) =
+  269       let ang = atan2 y x
+  270           minAngle = tau / len * i - pi
+  271           maxAngle = tau / len * (i+1) - pi
+  272       in ((ang-minAngle)/(maxAngle-minAngle), sqrt (x*x+y*y))
+  273     tau = 2*pi
+  274 
+  275 -- When is a triangulation valid?
+  276 --   Intersection: No internal edges intersect.
+  277 --   Completeness: All edge neighbours share a single internal edge.
+  278 isValidTriangulation :: Polygon -> Triangulation -> Bool
+  279 isValidTriangulation p t = isComplete && intersectionFree
+  280   where
+  281     o = polygonOffset p
+  282     isComplete = all isProper [0 .. pSize p-1]
+  283     isProper i =
+  284       let j = pNext p i in
+  285       length ((pPrev p i : (t V.! i)) `intersect` (pNext p j : t V.! j)) == 1
+  286     intersectionFree = and
+  287       [ case lineIntersect (pAccess p (a-o), pAccess p (b-o)) (pAccess p (c-o), pAccess p (d-o)) of
+  288           Nothing -> True
+  289           Just u  -> u == pAccess p (a-o) || u == pAccess p (b-o) ||
+  290                      u == pAccess p (c-o) || u == pAccess p (d-o)
+  291       | ((a,b),(c,d)) <- edgePairs ]
+  292     edgePairs = [ (e1, e2) | (e1, rest) <- zip edges (drop 1 $ tails edges), e2 <- rest]
+  293     edges =
+  294       [ (n, i)
+  295       | (n, lst) <- zip [0..] (V.toList t)
+  296       , i <- lst
+  297       , n < i
+  298       ]
+  299 
+  300 triangulationsToPolygons :: Polygon -> Triangulation -> [Polygon]
+  301 triangulationsToPolygons p t =
+  302   [ mkPolygon $ V.fromList
+  303     [ pAccess p g, pAccess p i, pAccess p j ]
+  304   | i <- [0 .. pSize p-1]
+  305   , let js = filter (i<) $ t V.! i
+  306   , (g, j) <- zip (i-1:js) js
+  307   ]
+  308 
+  309 pIsInside :: Polygon -> V2 Rational -> Bool
+  310 pIsInside p point = or
+  311   [ isInside (rawAccess g) (rawAccess i) (rawAccess j) point
+  312   | i <- [0 .. pSize p-1]
+  313   , let js = filter (i<) $ polygonTriangulation p V.! i
+  314   , (g, j) <- zip (i-1:js) js
+  315   ]
+  316   where
+  317     rawAccess x = polygonPoints p V.! x
+  318 
+  319 -- reducePolygons :: Int -> [Polygon] -> [Polygon]
+  320 -- reducePolygons n ps
+  321 --   | length ps <= n = ps
+  322 --   | otherwise =
+  323 --     let p = findSmallest ps
+  324 --         es = edges p
+  325 --         e = findSmallest es
+  326 --     in reducePolygons n (merge p e : delete p (delete e ps))
+  327 --   where
+  328 --     findSmallest = minimumBy (comparing area2X)
+  329 --     shareEdge p1 p2 =
+  330 
+  331 {-# INLINE pAccess #-}
+  332 pAccess :: APolygon a -> Int -> V2 a
+  333 pAccess p i = -- polygonPoints p V.! ((polygonOffset p + i) `mod` pSize p)
+  334   polygonPoints p `V.unsafeIndex` ((polygonOffset p + i) `mod` pSize p)
+  335 
+  336 triangle :: Polygon
+  337 triangle = mkPolygon $ V.fromList [V2 1 1, V2 0 0, V2 2 0]
+  338 
+  339 triangle' :: [P]
+  340 triangle' = reverse [V2 1 1, V2 0 0, V2 2 0]
+  341 
+  342 shape1 :: Polygon
+  343 shape1 = mkPolygon $ V.fromList
+  344   [ V2 0 0, V2 2 0
+  345   , V2 2 1, V2 2 2, V2 2 3, V2 2 4, V2 2 5, V2 2 6
+  346   , V2 1 1, V2 0 1 ]
+  347 
+  348 shape2 :: Polygon
+  349 shape2 = mkPolygon $ V.fromList
+  350   [ V2 0 0, V2 1 0, V2 1 1, V2 2 1, V2 2 (-1), V2 0 (-1), V2 0 (-2)
+  351   , V2 3 (-2), V2 3 2, V2 0 2]
+  352 
+  353 shape3 :: Polygon
+  354 shape3 = mkPolygon $ V.fromList
+  355   [ V2 0 0, V2 1 0, V2 1 1, V2 2 1, V2 2 2, V2 0 2]
+  356 
+  357 shape4 :: Polygon
+  358 shape4 = mkPolygon $ V.fromList
+  359   [ V2 0 0, V2 1 0, V2 1 1, V2 2 1, V2 2 (-1), V2 3 (-1),V2 3 2, V2 0 2]
+  360 
+  361 shape5 :: Polygon
+  362 shape5 = pCycles shape4 !! 2
+  363 
+  364 -- square
+  365 shape6 :: Polygon
+  366 shape6 = mkPolygon $ V.fromList [ V2 0 0, V2 1 0, V2 1 1, V2 0 1 ]
+  367 
+  368 shape7 :: Polygon
+  369 shape7 = pScale 6 $ mkPolygon $ V.fromList
+  370         [V2 ((-1567171105775771) % 144115188075855872) ((-7758063241391039) % 1152921504606846976)
+  371         ,V2 ((-2711114907999263) % 18014398509481984) ((-3561889280168807) % 18014398509481984)
+  372         ,V2 ((-6897139157863177) % 72057594037927936) ((-1632144794297397) % 4503599627370496)
+  373         ,V2 (5592137945106423 % 36028797018963968) ((-71351641856107) % 281474976710656)
+  374         ,V2 (2568147525079071 % 4503599627370496) ((-4312925637247687) % 18014398509481984)
+  375         ,V2 (1291079014395023 % 2251799813685248) (321513444515769 % 2251799813685248)
+  376         ,V2 (2071709221627247 % 4503599627370496) (4019115966736491 % 9007199254740992)
+  377         ,V2 ((-1589087869859839) % 144115188075855872) (4904023654354179 % 9007199254740992)
+  378         ,V2 ((-2328090886101149) % 36028797018963968) (2587887893460759 % 36028797018963968)
+  379         ,V2 ((-7990199074159871) % 18014398509481984) (1301850651537745 % 4503599627370496)]
+  380 
+  381 shape8 :: Polygon
+  382 shape8 = pScale 10 $ pGenerate
+  383           [(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)]
+  384 
+  385 shape9 :: Polygon
+  386 shape9 = pScale 5 $ pGenerate
+  387   [(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)]
+  388 
+  389 shape10 :: Polygon
+  390 shape10 = pGenerate
+  391   [(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)]
+  392 
+  393 shape11 :: Polygon
+  394 shape11 = pGenerate
+  395   [(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)]
+  396 
+  397 shape12 :: Polygon
+  398 shape12 = mkPolygon $ V.fromList
+  399   [ V2 0 0, V2 0.5 1.5, V2 2 2, V2 (-2) 2, V2 (-0.5) 1.5 ]
+  400 
+  401 -- F shape
+  402 shape13 :: Polygon
+  403 shape13 = pCycles (mkPolygon $ V.reverse (V.fromList
+  404   [ V2 0 0, V2 0 2
+  405   , V2 1 2, V2 1 1.7, V2 0.3 1.7, V2 0.3 1
+  406   , V2 1 1, V2 1 0.7
+  407   , V2 0.3 0.7, V2 0.3 0 ])) !! 7
+  408 
+  409 -- E shape
+  410 shape14 :: Polygon
+  411 shape14 = pCycles (mkPolygon $ V.reverse $ V.fromList
+  412   [ V2 0 0, V2 0 2 -- up
+  413   , V2 1 2, V2 1 1.7, V2 0.3 1.7, V2 0.3 1 -- first prong
+  414   , V2 1 1, V2 1 0.7, V2 0.3 0.7, V2 0.3 0.3 -- second prong
+  415   , V2 1 0.3, V2 1 0 -- last prong
+  416   ]) !! 9
+  417 
+  418 --
+  419 shape15 :: Polygon
+  420 shape15 = mkPolygon $ V.fromList
+  421   [ V2 0 0, V2 2 0
+  422   , V2 2 2, V2 1 2
+  423   , V2 1 1, V2 0 1]
+  424 
+  425 shape16 :: Polygon
+  426 shape16 = mkPolygon $ V.fromList
+  427   [ V2 0 0, V2 2 0
+  428   , V2 2 1, V2 1 1
+  429   , V2 1 2, V2 0 2]
+  430 
+  431 shape17 :: Polygon
+  432 shape17 = mkPolygon $ V.fromList
+  433   [ V2 2 0, V2 2 1
+  434   , V2 1 1, V2 1 2
+  435   , V2 0 2, V2 0 1, V2 0 0 ]
+  436 
+  437 shape18 :: Polygon
+  438 shape18 = mkPolygon $ V.fromList
+  439   [ V2 2 0, V2 2 1, V2 2 2
+  440   , V2 1 2, V2 1 1
+  441   , V2 0 1, V2 0 0 ]
+  442 
+  443 shape19 :: Polygon
+  444 shape19 = mkPolygon $ V.fromList
+  445   [ V2 (-3) (-3), V2 0 (-1)
+  446   , V2 3 (-3), V2 1 0
+  447   , V2 3 3, V2 0 1
+  448   , V2 (-3) 3, V2 (-1) 0 ]
+  449 
+  450 shape20 :: Polygon
+  451 shape20 = mkPolygon $ V.fromList
+  452   [ V2 (-3) (-3)
+  453   , V2 0 (-1)
+  454   , V2 3 (-3)
+  455   , V2 5 0
+  456   , V2 2.5 (-2)
+  457   , V2 1 0
+  458   , V2 3 3
+  459   , V2 0 1
+  460   , V2 (-3) 3
+  461   , V2 (-1) 0 ]
+  462 
+  463 shape21 :: Polygon
+  464 shape21 = mkPolygon $ V.fromList
+  465   [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)
+  466   ,V2 3.0 2.0,V2 0.0 2.0]
+  467 
+  468 shape22 :: Polygon
+  469 shape22 = pScale 2 $ mkPolygon $ V.fromList
+  470   [V2 (-0.17) (-0.08)
+  471   ,V2 (-0.34) (-0.21)
+  472   ,V2 0.0 0.0
+  473   ,V2 (-0.10) 0.60
+  474   ,V2 (-0.14) 0.19
+  475   ,V2 (-0.05) 0.03
+  476   ]
+  477 
+  478 shape23 :: Polygon
+  479 shape23 = mkPolygon $ V.fromList
+  480   [ V2 0 0, V2 4 0
+  481   , V2 4 3, V2 2 3
+  482   , V2 2 2, V2 3 2
+  483   , V2 3 1, V2 1 1
+  484   , V2 1 2, V2 2 2
+  485   , V2 2 3, V2 0 3 ]
+  486 
+  487 concave :: Polygon
+  488 concave = mkPolygon $
+  489   V.fromList [V2 0 0, V2 2 0, V2 2 2, V2 1 1, V2 0 2]
+  490 
+  491 pMkWinding :: Int -> Polygon
+  492 pMkWinding n | n < 1 = error "Polygon must have at least one winding."
+  493 pMkWinding n = mkPolygon $
+  494     V.fromList $ p0 : p1 : walkTo p1 1 n (V2 1 0) ++ reverse (walkTo p0 1 (n+2) (V2 (-1) 0))
+  495   where
+  496     p0 = V2 0 0
+  497     p1 = V2 0 1
+  498     walkTo at a b dir
+  499       | a == b = []
+  500       | otherwise =
+  501         let newAt = at + (dir ^* toRational a)
+  502         in newAt : walkTo newAt (a+1) b (rot dir)
+  503     rot (V2 x y) =
+  504       V2 y (-x)
+  505 
+  506 pDeoverlap :: Polygon -> Polygon
+  507 pDeoverlap p = mkPolygon arr
+  508   where
+  509     arr = V.generate (pSize p) worker
+  510     worker 0 = pAccess p 0
+  511     worker n =
+  512       if length (V.elemIndices (pAccess p n) (polygonPoints p)) /= 1
+  513         then
+  514           let prev = arr V.! (n-1)
+  515               this = pAccess p n
+  516           in lerp 0.99999 this prev
+  517         else pAccess p n
+  518 
+  519 pCycles :: APolygon a -> [APolygon a]
+  520 pCycles p = map (pAdjustOffset p) [0 .. pSize p-1]
+  521 
+  522 pCycle :: PolyCtx a => APolygon a -> Double -> APolygon a
+  523 pCycle p 0 = p
+  524 pCycle p t = mkPolygon $ worker 0 0
+  525   where
+  526     worker acc i
+  527       | segment + acc > limit =
+  528         V.singleton (lerp (realToFrac $ (segment + acc - limit)/segment) x y) <>
+  529         -- V.drop (i+1) (polygonPoints p) <>
+  530         V.fromList (map (pAccess p) [i+1..pSize p-1]) <>
+  531         V.fromList (map (pAccess p) [0 .. i])
+  532         -- V.take (i+1) (polygonPoints p)
+  533       | i == pSize p-1  = V.fromList (map (pAccess p) [0 .. pSize p-1])
+  534       | otherwise = worker (acc+segment) (i+1)
+  535         where
+  536           x = pAccess p i
+  537           y = pAccess p $ i+1
+  538           segment = distance' x y
+  539     len = pCircumference' p
+  540     limit = t * len
+  541 
+  542 pCentroid :: Fractional a => APolygon a -> V2 a
+  543 pCentroid p = V2 cx cy
+  544   where
+  545     a = pArea p
+  546     cx = recip (6*a) * V.sum (pMapEdges fnX p)
+  547     cy = recip (6*a) * V.sum (pMapEdges fnY p)
+  548     fnX (V2 x y) (V2 x' y') = (x+x')*(x*y' - x'*y)
+  549     fnY (V2 x y) (V2 x' y') = (y+y')*(x*y' - x'*y)
+  550 
+  551 {-# INLINE pMapEdges #-}
+  552 pMapEdges :: (V2 a -> V2 a -> b) -> APolygon a -> V.Vector b
+  553 pMapEdges fn p = V.generate n $ \i ->
+  554   if i == n-1
+  555     then fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` 0)
+  556     else fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` (i+1))
+  557   where
+  558     n = pSize p
+  559     arr = polygonPoints p
+  560 
+  561 {-# SPECIALIZE pArea :: APolygon Double -> Double #-}
+  562 {-# SPECIALIZE pArea :: APolygon Rational -> Rational #-}
+  563 pArea :: (Fractional a) => APolygon a -> a
+  564 pArea p =
+  565   -- 0.5 * V.sum (pMapEdges (\(V2 x y) (V2 x' y') -> x*y' - x'*y) p)
+  566   0.5 * worker 0 0
+  567   where
+  568     fn (V2 x y) (V2 x' y') = x*y' - x'*y
+  569     arr = polygonPoints p
+  570     worker !acc i
+  571       | i == pSize p - 1 = acc + fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` 0)
+  572       | otherwise =
+  573         worker (acc + fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` (i+1))) (i+1)
+  574 
+  575 pCircumference :: (Real a, Fractional a) => APolygon a -> a
+  576 pCircumference p = sum
+  577   [ approxDist (pAccess p i) (pAccess p $ i+1)
+  578   | i <- [0 .. pSize p-1]]
+  579 
+  580 pCircumference' :: (Real a, Fractional a) => APolygon a -> Double
+  581 pCircumference' p = sum
+  582   [ distance' (pAccess p i) (pAccess p $ i+1)
+  583   | i <- [0 .. pSize p-1]]
+  584 
+  585 
+  586 -- Add points by splitting the longest lines in half repeatedly.
+  587 pAddPoints :: PolyCtx a => Int -> APolygon a -> APolygon a
+  588 pAddPoints = pAddPointsRestricted []
+  589 
+  590 pAddPointsRestricted :: PolyCtx a => [(V2 a, V2 a)] -> Int -> APolygon a -> APolygon a
+  591 pAddPointsRestricted _immutableEdges n p | n <= 0 = p
+  592 pAddPointsRestricted immutableEdges n p = pAddPointsRestricted immutableEdges (n-1) $
+  593     mkPolygon $ V.fromList $ concatMap worker [0 .. pSize p-1]
+  594   where
+  595     isImmutable idx =
+  596       (pAccess p idx, pAccess p $ idx+1) `elem` immutableEdges ||
+  597       (pAccess p $ idx+1, pAccess p idx) `elem` immutableEdges
+  598     worker idx
+  599       | idx == longestEdge && not (isImmutable idx) =
+  600         [pAccess p idx, pMiddlePoint p idx]
+  601       | otherwise = [pAccess p idx]
+  602     longestEdge = maximumBy cmpLength [0 .. pSize p-1]
+  603     cmpLength a _ | isImmutable a = LT
+  604     cmpLength _ b | isImmutable b = GT
+  605     cmpLength a b =
+  606       distSquared (pAccess p a) (pAccess p $ a+1) `compare`
+  607       distSquared (pAccess p b) (pAccess p $ b+1)
+  608 
+  609 pMiddlePoint :: PolyCtx a => APolygon a -> Int -> V2 a
+  610 pMiddlePoint p idx
+  611   = lerp 0.5 (pAccess p $ idx+1) (pAccess p idx)
+  612 
+  613 pAddPointsBetween :: PolyCtx a => (Int, Int) -> Int -> APolygon a -> APolygon a
+  614 pAddPointsBetween _ n p | n <= 0 = p
+  615 pAddPointsBetween (i,l) n p = pAddPointsBetween (i,l+1) (n-1) $
+  616     mkPolygon $ V.fromList $ concatMap worker [0 .. pSize p-1]
+  617   where
+  618     worker idx
+  619       | idx == longestEdge =
+  620         [pAccess p idx, pMiddlePoint p idx]
+  621       | otherwise = [pAccess p idx]
+  622     longestEdge = maximumBy cmpLength [i .. i+l-1]
+  623     cmpLength a b =
+  624       distSquared (pAccess p a) (pAccess p $ a+1) `compare`
+  625       distSquared (pAccess p b) (pAccess p $ b+1)
+  626 
+  627 -- addPoints :: Int -> Polygon -> Polygon
+  628 -- addPoints n p = mkPolygon $ V.fromList $ worker n 0 (map (pAccess p) [0..s])
+  629 --   where
+  630 --     worker 0 _ rest = init rest
+  631 --     worker i acc (x:y:xs) =
+  632 --       let xy = approxDist x y in
+  633 --       if acc + xy > limit
+  634 --         then x : worker (i-1) 0 (lerp ((limit-acc)/xy) y x : y:xs)
+  635 --         else x : worker i (acc+xy) (y:xs)
+  636 --     worker _ _ [_] = []
+  637 --     worker _ _ _ = error "addPoints: invalid polygon"
+  638 --     s = pSize p
+  639 --     len = polygonLength p
+  640 --     limit = len / fromIntegral (n+1)
+  641 
+  642 pIsConvex :: Polygon -> Bool
+  643 pIsConvex p = and
+  644   [ area2X (pAccess p i) (pAccess p j) (pAccess p k) > 0
+  645   | i <- [0..n-1]
+  646   , j <- [i+1..n-1]
+  647   , k <- [j+1..n-1]
+  648   ]
+  649   where n = pSize p
+  650 
+  651 pIsCCW :: Polygon -> Bool
+  652 pIsCCW p | pNull p = False
+  653 pIsCCW p = V.sum (pMapEdges fn p) < 0
+  654   where
+  655     fn (V2 x1 y1) (V2 x2 y2) = (x2-x1)*(y2+y1)
+  656 
+  657 {-# INLINE pRayIntersect #-}
+  658 pRayIntersect :: PolyCtx a => APolygon a -> (Int, Int) -> (Int,Int) -> Maybe (V2 a)
+  659 pRayIntersect p (a,b) (c,d) =
+  660   rayIntersect (pAccess p a, pAccess p b) (pAccess p c, pAccess p d)
+  661 
+  662 pCuts :: (Real a, Fractional a, Epsilon a) => APolygon a -> [(APolygon a,APolygon a)]
+  663 pCuts p =
+  664   [ pCutAt (pAdjustOffset p i) (j-i)
+  665   | i <- [0 .. pSize p-1 ]
+  666   , j <- [i+2 .. pSize p-1 ]
+  667   , (j+1) `mod` pSize p /= i
+  668   , pParent p i j == i ]
+  669 
+  670 pCutEqual :: PolyCtx a => APolygon a -> (APolygon a, APolygon a)
+  671 pCutEqual p =
+  672     fromMaybe (p,p) $ listToMaybe $ sortOn f $ pCuts p
+  673   where
+  674     f (a,b) = abs (pArea a - pArea b)
+  675 
+  676 -- FIXME: This should be more efficient
+  677 pCutAt :: PolyCtx a => APolygon a -> Int -> (APolygon a, APolygon a)
+  678 pCutAt p i = (mkPolygon $ V.fromList left, mkPolygon $ V.fromList right)
+  679   where
+  680     n     = pSize p
+  681     left  = map (pAccess p) [0 .. i]
+  682     right = map (pAccess p) (0:[i..n-1])
+  683 
+  684 pOverlap :: PolyCtx a => APolygon a -> APolygon a -> APolygon a
+  685 pOverlap a b = mkPolygon $ V.fromList $ clearDups $ concatMap edgeIntersect [0 .. pSize a-1]
+  686   where
+  687     clearDups (x:y:xs)
+  688       | x == y = clearDups (y:xs)
+  689       | otherwise = x : clearDups (y:xs)
+  690     clearDups xs = xs
+  691     edgeIntersect edge =
+  692       sortOn (distSquared (pAccess a edge)) $ catMaybes
+  693       [ lineIntersect (aP, aP') (bP, bP')
+  694       | i <- [0 .. pSize b-1]
+  695       , let aP = pAccess a edge
+  696             aP' = pAccess a (edge+1)
+  697             bP = pAccess b i
+  698             bP' = pAccess b (i+1)
+  699       ]
+  700 
+  701 ---------------------------------------------------------
+  702 -- SSSP visibility and SSSP windows
+  703 
+  704 ssspVisibility :: PolyCtx a => APolygon a -> APolygon a
+  705 ssspVisibility p = mkPolygon $
+  706     V.fromList $ clearDups $ go [0 .. pSize p-1] -- ([root..pSize p-1]  ++ [0 .. root-1])
+  707   where
+  708     clearDups (x:y:xs)
+  709       | x == y = clearDups (y:xs)
+  710       | otherwise = x : clearDups (y:xs)
+  711     clearDups xs = xs
+  712     obstructedBy n =
+  713       case pParent p 0 n of
+  714         0 -> n
+  715         i -> obstructedBy i
+  716     go [] = []
+  717     go [x] = [pAccess p x]
+  718     go (x:y:xs) =
+  719       let xO = obstructedBy x
+  720           yO = obstructedBy y
+  721       in case () of
+  722           ()
+  723             -- Both ends are visible.
+  724             | xO == x && yO == y -> pAccess p x : go (y:xs)
+  725             -- X is visible, x to intersect (0,yO) (x,y)
+  726             | xO == x   ->
+  727               pAccess p x : fromMaybe (pAccess p y) (pRayIntersect p (0,yO) (x,y)) : go (y:xs)
+  728             -- Y is visible
+  729             | yO == y   -> fromMaybe (pAccess p x) (pRayIntersect p (0,xO) (x,y)) : pAccess p y : go (y:xs)
+  730             -- Neither is visible and they've obstructed by the same point
+  731             -- so the entire edge is hidden.
+  732             | xO == yO -> go (y:xs)
+  733             -- Neither is visible. Cast shadow from obstruction points to
+  734             -- find if a subsection of the edge is visible.
+  735             | otherwise ->
+  736               let a = fromMaybe (error "a") (pRayIntersect p (0,xO) (x,y))
+  737                   b = fromMaybe (error "b") (pRayIntersect p (0,yO) (x,y))
+  738               in if a /= b
+  739                 then a : b : go (y:xs)
+  740                 else go (y:xs)
+  741 
+  742 ssspWindows :: Polygon -> [(V2 Rational, V2 Rational)]
+  743 ssspWindows p = clearDups $ go (pAccess p 0) [0..pSize p-1]
+  744   where
+  745     clearDups (x:y:xs)
+  746       | x == y = clearDups (y:xs)
+  747       | otherwise = x : clearDups (y:xs)
+  748     clearDups xs = xs
+  749     obstructedBy n =
+  750       case pParent p 0 n of
+  751         0 -> n
+  752         i -> obstructedBy i
+  753     go _ [] = []
+  754     go _ [_] = []
+  755     go l (x:y:xs) =
+  756       let xO = obstructedBy x
+  757           yO = obstructedBy y
+  758       in case () of
+  759           ()
+  760             -- Both ends are visible.
+  761             | xO == x && yO == y -> go (pAccess p x) (y:xs)
+  762             -- X is visible, x to intersect (0,yO) (x,y)
+  763             | xO == x   ->
+  764               go (fromMaybe (pAccess p y) (pRayIntersect p (0,yO) (x,y))) (y:xs)
+  765             -- Y is visible
+  766             | yO == y   ->
+  767               let newL = fromMaybe (pAccess p x) (pRayIntersect p (0,xO) (x,y)) in
+  768               (l, newL) :
+  769               go newL (y:xs)
+  770             -- Neither is visible and they've obstructed by the same point
+  771             -- so the entire edge is hidden.
+  772             | xO == yO -> go l (y:xs)
+  773             -- Neither is visible. Cast shadow from obstruction points to
+  774             -- find if a subsection of the edge is visible.
+  775             | otherwise ->
+  776               let a = fromMaybe (error "a") (pRayIntersect p (0,xO) (x,y))
+  777                   b = fromMaybe (error "b") (pRayIntersect p (0,yO) (x,y))
+  778               in if a /= b
+  779                 then (l, a) : (b, pAccess p yO) : go (pAccess p yO) (y:xs)
+  780                 else go l (y:xs)
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Math.SSSP.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Math.SSSP.hs.html new file mode 100644 index 0000000..cd16a5e --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Math.SSSP.hs.html @@ -0,0 +1,390 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE FlexibleInstances     #-}
+    2 {-# LANGUAGE MultiParamTypeClasses #-}
+    3 {-# LANGUAGE RecordWildCards       #-}
+    4 {-# OPTIONS_GHC -fno-warn-orphans #-}
+    5 {-# OPTIONS_HADDOCK hide #-}
+    6 module Reanimate.Math.SSSP
+    7   ( -- * Single-Source-Shortest-Path
+    8     SSSP
+    9   , sssp                -- :: (Fractional a, Ord a) => Ring a -> Dual -> SSSP
+   10   , ssspFinger
+   11   , dual                -- :: Int -> Triangulation -> Dual
+   12   , Dual(..)
+   13   , DualTree(..)
+   14     -- * Misc
+   15   , dualToTriangulation -- :: Ring Rational -> Dual -> Triangulation
+   16   , visibilityArray     -- :: Ring Rational -> V.Vector [Int]
+   17   , naive               -- :: Ring Rational -> SSSP
+   18   , naive2              -- :: Ring Rational -> SSSP
+   19   , drawDual            -- :: Dual -> String
+   20   ) where
+   21 
+   22 import           Control.Monad
+   23 import           Control.Monad.ST
+   24 import qualified Data.FingerTree            as F
+   25 import           Data.Foldable
+   26 import           Data.List
+   27 import qualified Data.Map                   as Map
+   28 import           Data.Maybe
+   29 import           Data.STRef
+   30 import           Data.Tree
+   31 import qualified Data.Vector                as V
+   32 import qualified Data.Vector.Mutable        as MV
+   33 import           Reanimate.Math.Common
+   34 import           Reanimate.Math.Triangulate
+   35 
+   36 -- import           Debug.Trace
+   37 
+   38 type SSSP = V.Vector Int
+   39 
+   40 
+   41 -- ssspParent :: Polygon -> SSSP -> Int -> Int
+   42 -- ssspParent p sTree x =
+   43 --     (sTree V.! ((x - polygonOffset p) `mod` n) + polygonOffset p) `mod` n
+   44 --   where
+   45 --     n = polygonSize p
+   46 
+   47 visibilityArray :: Ring Rational -> V.Vector [Int]
+   48 visibilityArray p = arr
+   49   where
+   50     n = ringSize p
+   51     arr = V.fromList
+   52         [ visibility y
+   53         | y <- [0..n-1]
+   54         ]
+   55     visibility y =
+   56       [ i
+   57       | i <- [0..y-1]
+   58       , y `elem` arr V.! i ] ++
+   59       [ i
+   60       | i <- [y+1 .. n-1]
+   61       , let pI = ringAccess p i
+   62             isOpen = isRightTurn pYp pY pYn
+   63       , ringClamp p (y+1) == i || ringClamp p (y-1) == i || if isOpen
+   64         then isLeftTurnOrLinear pY pYn pI ||
+   65              isLeftTurnOrLinear pYp pY pI
+   66         else not $ isRightTurn pY pYn pI ||
+   67                    isRightTurn pYp pY pI
+   68       , let myEdges = [(e1,e2) | (e1,e2) <- edges, e1/=y, e1/=i, e2/=y,e2/=i]
+   69       , all (isNothing . lineIntersect (pY,pI))
+   70               [ (ringAccess p e1, ringAccess p e2) | (e1,e2) <- myEdges ]]
+   71       where
+   72         pY = ringAccess p y
+   73         pYn = ringAccess p $ y+1
+   74         pYp = ringAccess p $ y-1
+   75         edges = zip [0..n-1] (tail [0..n-1] ++ [0])
+   76 
+   77 
+   78 
+   79 -- Iterative Single Source Shortest Path solver. Quite slow.
+   80 naive :: Ring Rational -> SSSP
+   81 naive p =
+   82     V.fromList $ Map.elems $
+   83     Map.map snd $
+   84     worker initial
+   85   where
+   86     initial = Map.singleton 0 (0,0)
+   87     visibility = visibilityArray p
+   88     worker :: Map.Map Int (Rational, Int) -> Map.Map Int (Rational, Int)
+   89     worker m
+   90         | m==newM   = newM
+   91         | otherwise = worker newM
+   92       where
+   93         ms' = [ Map.fromList
+   94                     [ case Map.lookup v m of
+   95                         Nothing -> (v, (distThroughI, i))
+   96                         Just (otherDist,parent)
+   97                           | otherDist > distThroughI -> (v, (distThroughI, i))
+   98                           | otherwise -> (v, (otherDist, parent))
+   99                     | v <- visibility V.! i
+  100                     , let distThroughI = dist + approxDist (ringAccess p i) (ringAccess p v) ]
+  101               | (i,(dist,_)) <- Map.toList m
+  102               ]
+  103         newM = Map.unionsWith g (m:ms') :: Map.Map Int (Rational,Int)
+  104     g a b = if fst a < fst b then a else b
+  105 
+  106 naive2 :: Ring Rational -> SSSP
+  107 naive2 p = runST $ do
+  108     parents <- MV.replicate (ringSize p) (-1)
+  109     costs <- MV.replicate (ringSize p) (-1)
+  110     MV.write parents 0 0
+  111     MV.write costs 0 0
+  112     changedRef <- newSTRef False
+  113     let loop i
+  114           | i == ringSize p = do
+  115             changed <- readSTRef changedRef
+  116             when changed $ do
+  117               writeSTRef changedRef False
+  118               loop 0
+  119           | otherwise = do
+  120             myCost <- MV.read costs i
+  121             unless (myCost < 0) $
+  122               forM_ (visibility V.! i) $ \n -> do
+  123                 -- n is visible from i.
+  124                 theirCost <- MV.read costs n
+  125                 let throughCost = myCost + approxDist (ringAccess p i) (ringAccess p n)
+  126                 when (throughCost < theirCost || theirCost < 0) $ do
+  127                     MV.write parents n i
+  128                     MV.write costs n throughCost
+  129                     writeSTRef changedRef True
+  130             loop (i+1)
+  131     loop 0
+  132     V.unsafeFreeze parents
+  133   where
+  134     visibility = visibilityArray p
+  135 
+  136 -- Dual of triangulated polygon
+  137 data Dual = Dual (Int,Int,Int) -- (a,b,c)
+  138                   DualTree -- borders ca
+  139                   DualTree -- borders bc
+  140   deriving (Show)
+  141 
+  142 data DualTree
+  143   = EmptyDual
+  144   | NodeDual Int -- axb triangle, a and b are from parent.
+  145       DualTree -- borders xb
+  146       DualTree -- borders ax
+  147   deriving (Show)
+  148 
+  149 drawDual :: Dual -> String
+  150 drawDual d = drawTree $
+  151   case d of
+  152     Dual (a,b,c) l r -> Node (show (a,b,c)) [worker c a l, worker b c r]
+  153   where
+  154     worker _a _b EmptyDual = Node "Leaf" []
+  155     worker a b (NodeDual x l r) =
+  156       Node (show (b,a,x)) [worker x b l, worker a x r]
+  157 
+  158 dualToTriangulation :: Ring Rational -> Dual -> Triangulation
+  159 dualToTriangulation p d = edgesToTriangulation (ringSize p) $ filter goodEdge $
+  160     case d of
+  161       Dual (a,b,c) l r ->
+  162         (a,b):(a,c):(b,c):worker c a l ++ worker b c r
+  163   where
+  164     goodEdge (a,b)
+  165       = a /= ringClamp p (b+1) && a /= ringClamp p (b-1)
+  166     worker _a _b EmptyDual = []
+  167     worker a b (NodeDual x l r) =
+  168       (a,x) : (x, b) : worker x b l ++ worker a x r
+  169 
+  170 -- Dual path:
+  171 -- (Int,Int,Int) + V.Vector Int + V.Vector LeftOrRight
+  172 
+  173 -- simplifyDual :: DualTree -> DualTree
+  174 -- -- simplifyDual (NodeDual x EmptyDual EmptyDual) = NodeLeaf x
+  175 -- -- simplifyDual (NodeDual x l EmptyDual) = NodeDualL x l
+  176 -- -- simplifyDual (NodeDual x EmptyDual r) = NodeDualR x r
+  177 -- simplifyDual d = d
+  178 
+  179 dual :: Int -> Triangulation -> Dual
+  180 dual root t =
+  181   case hasTriangle of
+  182     []    -> error "weird triangulation"
+  183     -- [] -> Dual (0,1,V.length t-1) EmptyDual (dualTree t (1, (V.length t-1)) 0)
+  184     (x:_) -> Dual (root,rootNext,x) (dualTree t (x,root) rootNext) (dualTree t (rootNext,x) root)
+  185   where
+  186     rootNext = idx (root+1)
+  187     rootPrev = idx (root-1)
+  188     rootNNext = idx (root+2)
+  189     idx i = i `mod` n
+  190     hasTriangle = (rootPrev : t V.! root) `intersect` (rootNNext : t V.! rootNext)
+  191     n = V.length t
+  192 
+  193 -- a=6, b=0, e=1
+  194 dualTree :: Triangulation -> (Int,Int) -> Int -> DualTree
+  195 dualTree t (a,b) e = -- simplifyDual $
+  196     case hasTriangle of
+  197       [] -> EmptyDual
+  198       [ab] ->
+  199         NodeDual ab
+  200           (dualTree t (ab,b) a)
+  201           (dualTree t (a,ab) b)
+  202       _ -> error $ "Invalid triangulation: " ++ show (a,b,e,hasTriangle)
+  203   where
+  204     hasTriangle = (prev a : next a : t V.! a) `intersect` (prev b : next b : t V.! b)
+  205       \\ [e]
+  206     n = V.length t
+  207     next x = (x+1) `mod` n
+  208     prev x = (x-1) `mod` n
+  209 
+  210 
+  211 -- dualRoot :: Dual -> Int
+  212 -- dualRoot (Dual (a,_,_) _ _) = a
+  213 
+  214 -- O(n*ln n), could be O(n) if I could figure out how to use fingertrees...
+  215 sssp :: (Fractional a, Ord a, Epsilon a) => Ring a -> Dual -> SSSP
+  216 sssp p d = toSSSP $
+  217     case d of
+  218       Dual (a,b,c) l r ->
+  219         (a, a) :
+  220         (b, a) :
+  221         (c, a) :
+  222         worker [c] [b] a r ++
+  223         loopLeft a c l
+  224   where
+  225     toSSSP =
+  226       V.fromList . map snd . sortOn fst
+  227     loopLeft a outer l =
+  228       case l of
+  229         EmptyDual -> []
+  230         NodeDual x l' r' ->
+  231           (x,a) :
+  232           worker [x] [outer] a r' ++
+  233           loopLeft a x l'
+  234     searchFn _checkStep _cusp _x [] = Nothing
+  235     searchFn checkStep cusp x (y:ys)
+  236       | not (checkStep (ringAccess p cusp) (ringAccess p y) (ringAccess p x))
+  237         = Just $ helper [] y ys
+  238       | otherwise = Nothing
+  239       where
+  240         helper acc v [] = (v, [], reverse acc)
+  241         helper acc v1 (v2:vs)
+  242           | checkStep (ringAccess p v1) (ringAccess p v2) (ringAccess p x) =
+  243             (v1, v2:vs, reverse acc)
+  244           | otherwise = helper (v1:acc) v2 vs
+  245     searchRight = searchFn isLeftTurn
+  246     searchLeft = searchFn isRightTurn
+  247     -- adj x = x -- ringClamp p (x-dualRoot d)
+  248     -- optTrace msg =
+  249     --   if False -- dualRoot d == 1 || dualRoot d == 0
+  250     --     then trace msg
+  251     --     else id
+  252     worker _ _ _ EmptyDual = []
+  253     worker f1 f2 cusp (NodeDual x l r) =
+  254         -- (optTrace ("Funnel: " ++ show
+  255         --       (map adj $ toList f1
+  256         --       ,adj cusp
+  257         --       ,map adj $ toList f2
+  258         --       ,adj x
+  259         --       , dualRoot d))
+  260         --   ) $
+  261         case searchLeft cusp x (toList f1) of
+  262           Just (v, f1Hi, f1Lo) ->
+  263                 -- optTrace ("  Visble from left: " ++ show (adj x,adj v)) $
+  264                 (x, v::Int) :
+  265                 worker f1Hi [x] v l ++
+  266                 worker (f1Lo ++ [v, x]) f2 cusp r
+  267           Nothing ->
+  268             case searchRight cusp x (toList f2) of
+  269               Just (v, f2Hi, f2Lo) ->
+  270                 -- optTrace ("  Visble from right: " ++ show (adj x,adj v)) $
+  271                 (x, v::Int) :
+  272                 worker f1 (f2Lo ++ [v, x]) cusp l ++
+  273                 worker [x] f2Hi v r
+  274               Nothing ->
+  275                 -- optTrace ("  Visble from cusp: " ++ show (adj x,adj cusp)) $
+  276                 (x, cusp::Int) :
+  277                 worker f1 [x] cusp l ++
+  278                 worker [x] f2 cusp r
+  279 
+  280 data MinMax = MinMax Int Int | MinMaxEmpty deriving (Show)
+  281 instance Semigroup MinMax where
+  282   MinMaxEmpty <> b = b
+  283   a <> MinMaxEmpty = a
+  284   MinMax a _b <> MinMax _c d
+  285     = MinMax a d
+  286 instance Monoid MinMax where
+  287   mempty = MinMaxEmpty
+  288 
+  289 type Chain = F.FingerTree MinMax Int
+  290 data Funnel = Funnel
+  291   { funnelLeft  :: Chain
+  292   , funnelCusp  :: Int
+  293   , funnelRight :: Chain
+  294   }
+  295 
+  296 instance F.Measured MinMax Int where
+  297   measure i = MinMax i i
+  298 
+  299 splitFunnel :: (Epsilon a, Fractional a, Ord a) => Ring a -> Int -> Funnel -> (Int, Funnel, Funnel)
+  300 splitFunnel p x Funnel{..}
+  301     | isOnLeftChain =
+  302       case doSearch isRightTurn funnelLeft of
+  303         (lower, t, upper) ->
+  304           ( t
+  305           , Funnel upper t (F.singleton x)
+  306           , Funnel (lower F.|> t F.|> x) funnelCusp funnelRight)
+  307     | isOnRightChain =
+  308       case doSearch isLeftTurn funnelRight of
+  309         (lower, t, upper) ->
+  310           ( t
+  311           , Funnel funnelLeft funnelCusp (lower F.|> t F.|> x)
+  312           , Funnel (F.singleton x) t upper)
+  313     | otherwise =
+  314       ( funnelCusp
+  315       , Funnel funnelLeft funnelCusp (F.singleton x)
+  316       , Funnel (F.singleton x) funnelCusp funnelRight)
+  317   where
+  318     isOnLeftChain  = fromMaybe False $
+  319       isLeftTurnOrLinear cuspElt <$> leftElt <*> pure targetElt
+  320     isOnRightChain = fromMaybe False $
+  321       isRightTurnOrLinear cuspElt <$> rightElt <*> pure targetElt
+  322     doSearch fn chain =
+  323       case F.search (searchChain fn) (chain::Chain) of
+  324         F.Position lower t upper -> (lower, t, upper)
+  325         F.OnLeft                 -> error "cannot happen"
+  326         F.OnRight                -> error "cannot happen"
+  327         F.Nowhere                -> error "cannot happen"
+  328     searchChain _ MinMaxEmpty _             = False
+  329     searchChain _ _ MinMaxEmpty             = True
+  330     searchChain check (MinMax _ l) (MinMax r _) =
+  331       check (ringAccess p l) (ringAccess p r) targetElt
+  332     cuspElt   = ringAccess p funnelCusp
+  333     targetElt = ringAccess p x
+  334     leftElt   = ringAccess p <$> chainLeft funnelLeft
+  335     rightElt  = ringAccess p <$> chainLeft funnelRight
+  336     chainLeft chain =
+  337       case F.viewl chain of
+  338         F.EmptyL   -> Nothing
+  339         elt F.:< _ -> Just elt
+  340 
+  341 -- O(n)
+  342 ssspFinger :: (Epsilon a, Fractional a, Ord a) => Ring a -> Dual -> SSSP
+  343 ssspFinger p d = toSSSP $
+  344     case d of
+  345       Dual (a,b,c) l r ->
+  346         (a, a) :
+  347         (b, a) :
+  348         (c, a) :
+  349         worker (Funnel (F.singleton c) a (F.singleton b)) r ++
+  350         loopLeft a c l
+  351   where
+  352     toSSSP =
+  353       V.fromList . map snd . sortOn fst
+  354     loopLeft a outer l =
+  355       case l of
+  356         EmptyDual -> []
+  357         NodeDual x l' r' ->
+  358           (x,a) :
+  359           worker (Funnel (F.singleton x) a (F.singleton outer)) r' ++
+  360           loopLeft a x l'
+  361     worker _ EmptyDual = []
+  362     worker f (NodeDual x l r) =
+  363       case splitFunnel p x f of
+  364         (v, fL, fR) ->
+  365           (x, v) :
+  366           worker fL l ++
+  367           worker fR r
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Math.Triangulate.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Math.Triangulate.hs.html new file mode 100644 index 0000000..fe4995c --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Misc.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Misc.hs.html new file mode 100644 index 0000000..7a10433 --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Morph.Cache.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Morph.Cache.hs.html new file mode 100644 index 0000000..595a66d --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Morph.Common.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Morph.Common.hs.html new file mode 100644 index 0000000..8aa301d --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Morph.Linear.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Morph.Linear.hs.html new file mode 100644 index 0000000..5998766 --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Morph.Linear.hs.html @@ -0,0 +1,118 @@ + + + + + + +
+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 -- @
+   29 -- 'Reanimate.playThenReverseA' $ 'Reanimate.pauseAround' 0.5 0.5 $ 'Reanimate.mkAnimation' 3 $ \\t ->
+   30 --   'Reanimate.withStrokeLineJoin' 'Graphics.SvgTree.JoinRound' $
+   31 --   let src = 'Reanimate.scale' 8 $ 'Reanimate.center' $ 'Reanimate.LaTeX.latex' \"X\"
+   32 --       dst = 'Reanimate.scale' 8 $ 'Reanimate.center' $ 'Reanimate.LaTeX.latex' \"H\"
+   33 --   in 'morph' 'linear' src dst t
+   34 -- @
+   35 --
+   36 --   <<docs/gifs/doc_linear.gif>>
+   37 linear :: Morph
+   38 linear = rawLinear
+   39   { morphPointCorrespondence  =
+   40       cachePointCorrespondence (hash ("closest"::String))
+   41         closestLinearCorrespondence }
+   42 
+   43 -- | Linear interpolation strategy without realigning corners.
+   44 --   May give better results if the polygons are already aligned.
+   45 --   Usually gives worse results.
+   46 --
+   47 --   Example:
+   48 --
+   49 -- @
+   50 -- 'Reanimate.playThenReverseA' $ 'Reanimate.pauseAround' 0.5 0.5 $ 'Reanimate.mkAnimation' 3 $ \\t ->
+   51 --   'Reanimate.withStrokeLineJoin' 'Graphics.SvgTree.JoinRound' $
+   52 --   let src = 'Reanimate.scale' 8 $ 'Reanimate.center' $ 'Reanimate.LaTeX.latex' \"X\"
+   53 --       dst = 'Reanimate.scale' 8 $ 'Reanimate.center' $ 'Reanimate.LaTeX.latex' \"H\"
+   54 --   in 'morph' 'rawLinear' src dst t
+   55 -- @
+   56 --
+   57 --   <<docs/gifs/doc_rawLinear.gif>>
+   58 rawLinear :: Morph
+   59 rawLinear = Morph
+   60   { morphTolerance            = 0.001
+   61   , morphColorComponents      = labComponents
+   62   , morphPointCorrespondence  = normalizePolygons
+   63   , morphTrajectory           = linearTrajectory
+   64   , morphObjectCorrespondence = splitObjectCorrespondence }
+   65 
+   66 -- | Cycle polygons until the sum of the point trajectory path lengths
+   67 --   is smallest.
+   68 closestLinearCorrespondence :: PointCorrespondence
+   69 closestLinearCorrespondence = closestLinearCorrespondenceA
+   70 
+   71 -- | Cycle polygons until the sum of the point trajectory path lengths
+   72 --   is smallest.
+   73 closestLinearCorrespondenceA :: (Real a, Fractional a, Epsilon a) => APolygon a -> APolygon a -> (APolygon a, APolygon a)
+   74 closestLinearCorrespondenceA src' dst' =
+   75     (src, worker dst (score dst) options)
+   76   where
+   77     (src, dst) = normalizePolygons src' dst'
+   78     worker bestP _bestPScore [] = bestP
+   79     worker bestP bestPScore (x:xs) =
+   80       let newScore = score x in
+   81       if newScore < bestPScore
+   82         then worker x newScore xs
+   83         else worker bestP bestPScore xs
+   84     options = pCycles dst
+   85     score p = sum
+   86       [ -- approxDist (pAccess src n) (pAccess p n)
+   87         distSquared (pAccess src n) (pAccess p n)
+   88       | n <- [0 .. pSize src-1] ]
+   89 
+   90 -- | Strategy for moving points in a linear (straight-line) trajectory.
+   91 linearTrajectory :: Trajectory
+   92 linearTrajectory (src,dst)
+   93   | pSize src == pSize dst = \t -> mkPolygon $
+   94     V.zipWith (lerp $ realToFrac t) (polygonPoints dst) (polygonPoints src)
+   95   | otherwise = error $ "Invalid lengths: " ++ show (pSize src, pSize dst)
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Parameters.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Parameters.hs.html new file mode 100644 index 0000000..7bf78d5 --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.PolyShape.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.PolyShape.hs.html new file mode 100644 index 0000000..f9892fc --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.PolyShape.hs.html @@ -0,0 +1,472 @@ + + + + + + +
+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 (..),
+   54                                                                        CubicBezier (..),
+   55                                                                        FillRule (..), PathJoin (..),
+   56                                                                        QuadBezier (..), arcLength,
+   57                                                                        arcLengthParam,
+   58                                                                        bezierIntersection,
+   59                                                                        bezierSubsegment,
+   60                                                                        closedPathCurves, closest,
+   61                                                                        colinear, curvesToClosed,
+   62                                                                        evalBezier, quadToCubic,
+   63                                                                        reorient, splitBezier, union,
+   64                                                                        vectorDistance)
+   65 import           Graphics.SvgTree                                     (PathCommand (..), RPoint,
+   66                                                                        Tree, defaultSvg,
+   67                                                                        pathDefinition, pathTree)
+   68 import           Linear.V2
+   69 import           Reanimate.Animation
+   70 import           Reanimate.Constants
+   71 import           Reanimate.Math.Polygon                               (Polygon, mkPolygon, pArea,
+   72                                                                        pIsCCW)
+   73 import           Reanimate.Svg
+   74 
+   75 -- | Shape drawn by continuous line. May have overlap, may be convex.
+   76 newtype PolyShape = PolyShape { unPolyShape :: ClosedPath Double }
+   77   deriving (Show)
+   78 
+   79 -- | Polyshape with smaller, fully-enclosed holes.
+   80 data PolyShapeWithHoles = PolyShapeWithHoles
+   81   { polyShapeParent :: PolyShape
+   82   , polyShapeHoles  :: [PolyShape]
+   83   }
+   84 
+   85 
+   86 -- | Render a set of polyshapes as a single SVG path.
+   87 renderPolyShapes :: [PolyShape] -> Tree
+   88 renderPolyShapes pls =
+   89   pathTree $ defaultSvg & pathDefinition .~ concatMap plPathCommands pls
+   90 
+   91 -- | Render a polyshape as a single SVG path.
+   92 renderPolyShape :: PolyShape -> Tree
+   93 renderPolyShape pl =
+   94     pathTree $ defaultSvg & pathDefinition .~ plPathCommands pl
+   95 
+   96 -- | Render control-points of a polyshape as circles.
+   97 renderPolyShapePoints :: PolyShape -> Tree
+   98 renderPolyShapePoints = mkGroup . map renderPoint . plCurves
+   99   where
+  100     renderPoint (CubicBezier (V2 x y) _ _ _) =
+  101       translate x y $ mkCircle 0.02
+  102 
+  103 -- | Length of polyshape circumference.
+  104 plLength :: PolyShape -> Double
+  105 plLength = sum . map cubicLength . plCurves
+  106   where
+  107     cubicLength c = arcLength c 1 polyShapeTolerance
+  108 
+  109 -- | Area of polyshape.
+  110 plArea :: PolyShape -> Double
+  111 plArea pl = realToFrac $ pArea $ plToPolygon polyShapeTolerance pl
+  112 
+  113 -- 1/10th of a pixel if rendered at 2560x1440
+  114 polyShapeTolerance :: Double
+  115 polyShapeTolerance = screenWidth/25600
+  116 
+  117 -- | Construct a polyshape from the vertices in a polygon.
+  118 plFromPolygon :: [RPoint] -> PolyShape
+  119 plFromPolygon = PolyShape . ClosedPath . map worker
+  120   where
+  121     worker val = (val, JoinLine)
+  122 
+  123 -- | Approximate a polyshape as a polygon within the given tolerance.
+  124 plToPolygon :: Double -> PolyShape -> Polygon
+  125 plToPolygon tol pl =
+  126   let p = V.init . V.fromList . map (fmap realToFrac) .
+  127           plPolygonify tol $ pl
+  128   in if pIsCCW (mkPolygon p) then mkPolygon p else mkPolygon (V.reverse p)
+  129 
+  130 -- | Partially draw polyshape.
+  131 plPartial :: Double -> PolyShape -> PolyShape
+  132 plPartial delta pl | delta >= 1 = pl
+  133 plPartial delta pl = PolyShape $ curvesToClosed (lineOut ++ [joinB] ++ lineIn)
+  134   where
+  135     lineOutEnd = cubicC3 (last lineOut)
+  136     lineInBegin = cubicC0 (head lineIn)
+  137     joinB = CubicBezier lineOutEnd lineOutEnd lineOutEnd lineInBegin
+  138     lineOut = takeLen (len*delta/2) $ plCurves pl
+  139     lineIn =
+  140       reverse $ map reorient $
+  141       takeLen (len*delta/2) $ reverse $ map reorient $ plCurves pl
+  142     len = plLength pl
+  143     takeLen _ [] = []
+  144     takeLen l (c:cs) =
+  145       let cLen = arcLength c 1 polyShapeTolerance in
+  146       if l < cLen
+  147         then [bezierSubsegment c 0 (arcLengthParam c l polyShapeTolerance)]
+  148         else c : takeLen (l-cLen) cs
+  149 
+  150 -- plPartial' :: Double -> ([RPoint], PolyShape) -> PolyShape
+  151 -- plPartial' delta (seen', PolyShape (ClosedPath lst)) =
+  152 --   case lst of
+  153 --     []                         -> PolyShape (ClosedPath [])
+  154 --     (startP, startJoin) : rest -> PolyShape $ ClosedPath $
+  155 --       (startP, startJoin) : worker startP rest
+  156 --   where
+  157 --     seen = filter (`elem` plPoints) seen'
+  158 --     closestSeen pt = minimumBy (comparing (vectorDistance pt)) seen
+  159 --     worker _ [] = []
+  160 --     worker _ ((newP, newJoin) : rest)
+  161 --       | newP `elem` seen = (newP, newJoin) : worker newP rest
+  162 --       | otherwise =
+  163 --         let newAt = interpolateVector (closestSeen newP) newP delta
+  164 --         in (newAt, newJoin) : worker newAt rest
+  165 --     plPoints =
+  166 --       [ p | (p,_) <- lst ]
+  167 
+  168 -- | Find intersection points.
+  169 plGroupTouching :: [PolyShape] -> [[([RPoint],PolyShape)]]
+  170 plGroupTouching [] = []
+  171 plGroupTouching pls = worker [polyShapeOrigin (head pls)] pls
+  172   where
+  173     worker _ [] = []
+  174     worker seen shapes =
+  175       let (touching, notTouching) = partition (isTouching seen) shapes
+  176       in if null touching
+  177         then plGroupTouching notTouching
+  178         else map ((,) seen . changeOrigin seen) touching   :
+  179              worker (seen ++ concatMap plPoints touching) notTouching
+  180     isTouching pts = any (`elem` pts) . plPoints
+  181     changeOrigin seen (PolyShape (ClosedPath segments)) = PolyShape $ ClosedPath $ helper [] segments
+  182       where
+  183         helper acc [] = reverse acc
+  184         helper acc lst@((startP,startJ):rest)
+  185           | startP `elem` seen = lst ++ reverse acc
+  186           | otherwise = helper ((startP, startJ):acc) rest
+  187     plPoints :: PolyShape -> [RPoint]
+  188     plPoints (PolyShape (ClosedPath lst)) =
+  189       [ p | (p,_) <- lst ]
+  190 
+  191 -- | Deconstruct a polyshape into non-intersecting, convex polygons.
+  192 plDecompose :: [PolyShape] -> [[RPoint]]
+  193 plDecompose = plDecompose' 0.001
+  194 
+  195 -- | Deconstruct a polyshape into non-intersecting, convex polygons.
+  196 plDecompose' :: Double -> [PolyShape] -> [[RPoint]]
+  197 plDecompose' tol =
+  198   concatMap (decomposePolygon . plPolygonify tol . mergePolyShapeHoles) .
+  199   plGroupShapes .
+  200   unionPolyShapes
+  201 
+  202 -- | Split polygon into smaller, convex polygons.
+  203 decomposePolygon :: [RPoint] -> [[RPoint]]
+  204 decomposePolygon poly =
+  205   [ [ V2 x y
+  206     | v <- V.toList (Geo.boundaryVertices f pg)
+  207     , let Geo.Point2 x y = pg^.Geo.vertexDataOf v . Geo.location ]
+  208   | (f, Inside) <- V.toList (Geo.internalFaces pg) ]
+  209 
+  210   where
+  211     pg = triangulate' Proxy p
+  212     p = Geo.fromPoints $
+  213       [ Geo.Point2 x y :+ ()
+  214       | V2 x y <- poly ]
+  215 
+  216 plPolygonify :: Double -> PolyShape -> [RPoint]
+  217 plPolygonify tol shape =
+  218     startPoint (head curves) : concatMap worker curves
+  219   where
+  220     curves = plCurves shape
+  221     worker c | endPoint c == startPoint c =
+  222       [] -- error $ "Bad bezier: " ++ show c
+  223     worker c =
+  224       if colinear c tol -- && arcLength c 1 tol < 1
+  225         then [endPoint c]
+  226         else
+  227           let (lhs,rhs) = splitBezier c 0.5
+  228           in worker lhs ++ worker rhs
+  229     endPoint (CubicBezier _ _ _ d) = d
+  230     startPoint (CubicBezier a _ _ _) = a
+  231 
+  232 -- | Convert a polyshape to a list of SVG path commands.
+  233 plPathCommands :: PolyShape -> [PathCommand]
+  234 plPathCommands = lineToPath . plLineCommands
+  235 
+  236 -- | Convert a polyshape to a list of line commands.
+  237 plLineCommands :: PolyShape -> [LineCommand]
+  238 plLineCommands pl =
+  239   case curves of
+  240     []                  -> []
+  241     (CubicBezier start _ _ _:_) ->
+  242       LineMove start :
+  243       zipWith worker (drop 1 dstList ++ [start]) joinList ++
+  244       [LineEnd start]
+  245   where
+  246     ClosedPath closedPath = unPolyShape pl
+  247     (dstList, joinList) = unzip closedPath
+  248     curves = plCurves pl
+  249     worker dst JoinLine =
+  250       LineBezier [dst]
+  251     worker dst (JoinCurve a b) =
+  252       LineBezier [a,b,dst]
+  253 
+  254 -- | Extract all shapes from SVG nodes. Drawing attributes such
+  255 --   as stroke and fill color are discarded.
+  256 svgToPolyShapes :: Tree -> [PolyShape]
+  257 svgToPolyShapes = cmdsToPolyShapes . toLineCommands . extractPath
+  258 
+  259 -- | Extract all polygons from SVG nodes. Curves are approximated to
+  260 --   within the given tolerance.
+  261 svgToPolygons :: Double -> SVG -> [Polygon]
+  262 svgToPolygons tol = map (toPolygon . plPolygonify tol) . svgToPolyShapes
+  263   where
+  264     toPolygon :: [RPoint] -> Polygon
+  265     toPolygon = mkPolygon .
+  266       V.fromList . nub . map (fmap realToFrac)
+  267 
+  268 cmdsToPolyShapes :: [LineCommand] -> [PolyShape]
+  269 cmdsToPolyShapes [] = []
+  270 cmdsToPolyShapes cmds =
+  271     case cmds of
+  272       (LineMove dst:cont) -> map PolyShape $ worker dst [] cont
+  273       _                   -> bad
+  274   where
+  275     bad = error $ "Reanimate.PolyShape: Invalid commands: " ++ show cmds
+  276     finalize [] rest  = rest
+  277     finalize acc rest = ClosedPath (reverse acc) : rest
+  278     worker _from acc [] = finalize acc []
+  279     worker _from acc (LineMove newStart : xs) =
+  280       finalize acc $
+  281       worker newStart [] xs
+  282     worker from acc (LineEnd orig:LineMove dst:xs) | from /= orig =
+  283       finalize ((from, JoinLine):acc) $
+  284       worker dst [] xs
+  285     worker _from acc (LineEnd{}:LineMove dst:xs) =
+  286       finalize acc $
+  287       worker dst [] xs
+  288     worker from acc [LineEnd orig] | from /= orig =
+  289       finalize ((from, JoinLine):acc) []
+  290     worker _from acc [LineEnd{}] =
+  291       finalize acc []
+  292     worker from acc (LineBezier [x]:xs) =
+  293       worker x ((from, JoinLine) : acc) xs
+  294     worker from acc (LineBezier [a,b]:xs) =
+  295       let quad = QuadBezier from a b
+  296           CubicBezier _ a' b' c' = quadToCubic quad
+  297       in worker from acc (LineBezier [a',b',c']:xs)
+  298     worker from acc (LineBezier [a,b,c]:xs) =
+  299       worker c ((from, JoinCurve a b) : acc) xs
+  300     worker _ _ _ = bad
+  301 
+  302 -- | Merge overlapping shapes.
+  303 unionPolyShapes :: [PolyShape] -> [PolyShape]
+  304 unionPolyShapes shapes =
+  305     map PolyShape $
+  306     union (map unPolyShape shapes) FillNonZero (polyShapeTolerance/10000)
+  307 
+  308 -- | Merge overlapping shapes to within given tolerance.
+  309 unionPolyShapes' :: Double -> [PolyShape] -> [PolyShape]
+  310 unionPolyShapes' tol shapes =
+  311     map PolyShape $
+  312     union (map unPolyShape shapes) FillNonZero tol
+  313 
+  314 -- | True iff lhs is inside of rhs.
+  315 --   lhs and rhs may not overlap.
+  316 --   Implementation: Trace a vertical line through the origin of A and check
+  317 --   of this line intersects and odd number of times on both sides of A.
+  318 isInsideOf :: PolyShape -> PolyShape -> Bool
+  319 lhs `isInsideOf` rhs =
+  320     odd (length upHits) && odd (length downHits)
+  321   where
+  322     (upHits, downHits) = polyIntersections origin rhs
+  323     origin = polyShapeOrigin lhs
+  324 
+  325 polyIntersections :: RPoint -> PolyShape -> ([RPoint],[RPoint])
+  326 polyIntersections origin rhs =
+  327     (nub $ concatMap (intersections rayUp) curves
+  328     ,nub $ concatMap (intersections rayDown) curves)
+  329   where
+  330     curves = plCurves rhs
+  331 
+  332     intersections line bs =
+  333       map (evalBezier bs . fst) (bezierIntersection bs line polyShapeTolerance)
+  334     limit = 1000
+  335     rayUp = CubicBezier origin origin origin (V2 limit limit)
+  336     rayDown = CubicBezier origin origin origin (V2 (-limit) (-limit))
+  337 
+  338 polyShapeOrigin :: PolyShape -> V2 Double
+  339 polyShapeOrigin (PolyShape closedPath) =
+  340   case closedPath of
+  341     ClosedPath []            -> V2 0 0
+  342     ClosedPath ((start,_):_) -> start
+  343 
+  344 -- | Find holes and group them with their parent.
+  345 plGroupShapes :: [PolyShape] -> [PolyShapeWithHoles]
+  346 plGroupShapes = worker
+  347   where
+  348     worker (s:rest)
+  349       | null (parents s rest) =
+  350         let isOnlyChild x = parents x (s:rest) == [s]
+  351             (holes, nonHoles) = partition isOnlyChild rest
+  352             prime = PolyShapeWithHoles
+  353               { polyShapeParent = s
+  354               , polyShapeHoles  = holes }
+  355         in prime : worker nonHoles
+  356       | otherwise = worker (rest ++ [s])
+  357     worker [] = []
+  358 
+  359     parents :: PolyShape -> [PolyShape] -> [PolyShape]
+  360     parents self = filter (self `isInsideOf`) . filter (/=self)
+  361 
+  362 instance Eq PolyShape where
+  363   a == b = plCurves a == plCurves b
+  364 
+  365 -- | Cut out holes.
+  366 mergePolyShapeHoles :: PolyShapeWithHoles -> PolyShape
+  367 mergePolyShapeHoles (PolyShapeWithHoles parent []) = parent
+  368 mergePolyShapeHoles (PolyShapeWithHoles parent (child:children)) =
+  369   mergePolyShapeHoles $
+  370     PolyShapeWithHoles (mergePolyShapeHole parent child) children
+  371 
+  372 -- Merge
+  373 mergePolyShapeHole :: PolyShape -> PolyShape -> PolyShape
+  374 mergePolyShapeHole parent child =
+  375   snd $ head $
+  376   sortOn fst
+  377   [ cutSingleHole newParent child
+  378   | newParent <- polyShapePermutations parent ]
+  379 
+  380 {-
+  381 parent:
+  382   (a,b)
+  383   (b,c)
+  384   (c,a)
+  385 
+  386 child:
+  387   (x,y)
+  388   (y,z)
+  389   (z,x)
+  390 
+  391 P = split (a,b)
+  392 new:
+  393   (P,b) p2b
+  394   (b,c) pTail
+  395   (c,a) pTail
+  396   (a,P) a2p
+  397 
+  398   (P,x) p2x
+  399 
+  400   (x,y) childCurves
+  401   (y,z) childCurves
+  402   (z,x) childCurves
+  403 
+  404   (x,P) x2p
+  405 
+  406 -}
+  407 cutSingleHole :: PolyShape -> PolyShape -> (Double, PolyShape)
+  408 cutSingleHole parent child =
+  409     (score, PolyShape $ curvesToClosed $
+  410       p2b:pTail ++ [a2p] ++
+  411       [p2x] ++ childCurves ++
+  412       [x2p]
+  413     )
+  414   where
+  415     -- vect = (childOrigin - p) * 0 -- 0.0001
+  416     vectL = 0 -- rotate90L $* vect
+  417     vectR = 0 -- rotate90R $* vect
+  418     score = vectorDistance childOrigin p
+  419     childOrigin = polyShapeOrigin child
+  420     childOrigin' = childOrigin - vectL
+  421     (pHead:pTail) = plCurves parent
+  422     childCurves = plCurves child
+  423 
+  424     pParam = closest pHead childOrigin polyShapeTolerance
+  425 
+  426     (a2p, p2b') = splitBezier pHead pParam
+  427     p2b = case p2b' of
+  428       CubicBezier a b c d -> CubicBezier (a - vectL) b c d
+  429 
+  430     p = evalBezier pHead pParam
+  431     -- straight line to child origin
+  432     p2x = lineBetween (p - vectR) childOrigin
+  433     -- straight line from child origin
+  434     x2p = lineBetween childOrigin' p
+  435 
+  436     lineBetween a = CubicBezier a a a
+  437 
+  438 -- | Destruct a polyshape into constituent curves.
+  439 plCurves :: PolyShape -> [CubicBezier Double]
+  440 plCurves = closedPathCurves . unPolyShape
+  441 
+  442 polyShapePermutations :: PolyShape -> [PolyShape]
+  443 polyShapePermutations =
+  444     map (PolyShape . curvesToClosed) . cycleList . plCurves
+  445   where
+  446     cycleList lst =
+  447       let n = length lst in
+  448       [ take n $ drop i $ cycle lst
+  449       | i <- [0.. n-1] ]
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Raster.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Raster.hs.html new file mode 100644 index 0000000..3b64dd6 --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Raster.hs.html @@ -0,0 +1,339 @@ + + + + + + +
+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                                                           , defaultSvg
+   41                                                           , parseSvgFile
+   42                                                           )
+   43 import qualified Graphics.SvgTree              as Svg
+   44 import           Reanimate.Animation
+   45 import           Reanimate.Cache
+   46 import           Reanimate.Driver.Magick
+   47 import           Reanimate.Misc
+   48 import           Reanimate.Render
+   49 import           Reanimate.Parameters
+   50 import           Reanimate.Constants
+   51 import           Reanimate.Svg.Constructors
+   52 import           Reanimate.Svg.Unuse
+   53 import           System.Directory
+   54 import           System.FilePath
+   55 import           System.IO
+   56 import           System.IO.Temp
+   57 import           System.IO.Unsafe
+   58 
+   59 -- | Load an external image. Width and height must be specified,
+   60 --   ignoring the image's aspect ratio. The center of the image is
+   61 --   placed at position (0,0).
+   62 --
+   63 --   For security reasons, must SVG renderer do not allow arbitrary
+   64 --   image links. For some renderers, we can get around this by placing
+   65 --   the images in the same root directory as the parent SVG file. Other
+   66 --   renderers (like Chrome and ffmpeg) requires that the image is inlined
+   67 --   as base64 data. External SVG files are an exception, though, as must
+   68 --   always be inlined directly. `mkImage` attempts to hide all the complexity
+   69 --   but edge-cases may exist.
+   70 --
+   71 --   Example:
+   72 --
+   73 -- @
+   74 -- 'mkImage' 'screenWidth' 'screenHeight' \"..\/data\/haskell.svg\"
+   75 -- @
+   76 --
+   77 --   <<docs/gifs/doc_mkImage.gif>>
+   78 mkImage
+   79   :: Double -- ^ Desired image width.
+   80   -> Double -- ^ Desired image height.
+   81   -> FilePath -- ^ Path to external image file.
+   82   -> SVG
+   83 mkImage width height path | takeExtension path == ".svg" = unsafePerformIO $ do
+   84   svg_data <- B.readFile path
+   85   case parseSvgFile path svg_data of
+   86     Nothing -> error "Malformed svg"
+   87     Just svg ->
+   88       return
+   89         $ scaleXY (width / screenWidth) (height / screenHeight)
+   90         $ embedDocument svg
+   91 mkImage width height path | pRaster == RasterNone = unsafePerformIO $ do
+   92   inp <- LBS.readFile path
+   93   let imgData = LBS.unpack $ Base64.encode inp
+   94   return
+   95     $  flipYAxis
+   96     $  Svg.imageTree
+   97     $  defaultSvg
+   98     &  Svg.imageWidth
+   99     .~ Svg.Num width
+  100     &  Svg.imageHeight
+  101     .~ Svg.Num height
+  102     &  Svg.imageHref
+  103     .~ ("data:" ++ mimeType ++ ";base64," ++ imgData)
+  104     &  Svg.imageCornerUpperLeft
+  105     .~ (Svg.Num (-width / 2), Svg.Num (-height / 2))
+  106     &  Svg.imageAspectRatio
+  107     .~ Svg.PreserveAspectRatio False Svg.AlignNone Nothing
+  108  where
+  109     -- FIXME: Is there a better way to do this?
+  110   mimeType = case takeExtension path of
+  111     ".jpg" -> "image/jpeg"
+  112     ext    -> "image/" ++ drop 1 ext
+  113 mkImage width height path = unsafePerformIO $ do
+  114   exists <- doesFileExist target
+  115   unless exists $ copyFile path target
+  116   return
+  117     $  flipYAxis
+  118     $  Svg.imageTree
+  119     $  defaultSvg
+  120     &  Svg.imageWidth
+  121     .~ Svg.Num width
+  122     &  Svg.imageHeight
+  123     .~ Svg.Num height
+  124     &  Svg.imageHref
+  125     .~ ("file://" ++ target)
+  126     &  Svg.imageCornerUpperLeft
+  127     .~ (Svg.Num (-width / 2), Svg.Num (-height / 2))
+  128     &  Svg.imageAspectRatio
+  129     .~ Svg.PreserveAspectRatio False Svg.AlignNone Nothing
+  130  where
+  131   target   = pRootDirectory </> encodeInt hashPath <.> takeExtension path
+  132   hashPath = hash path
+  133 
+  134 -- | Write in-memory image to cache file if (and only if) such cache file doesn't
+  135 --   already exist.
+  136 cacheImage :: (PngSavable pixel, Hashable a) => a -> Image pixel -> FilePath
+  137 cacheImage key gen = unsafePerformIO $ cacheFile template $ \path ->
+  138   writePng path gen
+  139   where template = encodeInt (hash key) <.> "png"
+  140 
+  141 -- Warning: Caching svg elements with links to external objects does
+  142 --          not work. 2020-06-01
+  143 -- | Same as 'prerenderSvg' but returns the location of the rendered image
+  144 --   as a FilePath.
+  145 prerenderSvgFile :: Hashable a => a -> Width -> Height -> SVG -> FilePath
+  146 prerenderSvgFile key width height svg =
+  147   unsafePerformIO $ cacheFile template $ \path -> do
+  148     let svgPath = replaceExtension path "svg"
+  149     writeFile svgPath rendered
+  150     engine <- requireRaster pRaster
+  151     applyRaster engine svgPath
+  152  where
+  153   template = encodeInt (hash (key, width, height)) <.> "png"
+  154   rendered = renderSvg (Just $ Px $ fromIntegral width)
+  155                        (Just $ Px $ fromIntegral height)
+  156                        svg
+  157 
+  158 -- | Render SVG node to a PNG file and return a new node containing
+  159 --   that image. For static SVG nodes, this can hugely improve performance.
+  160 --   The first argument is the key that determines SVG uniqueness. It
+  161 --   is entirely your responsibility to ensure that all keys are unique.
+  162 --   If they are not, you will be served stale results from the cache.
+  163 prerenderSvg :: Hashable a => a -> SVG -> SVG
+  164 prerenderSvg key =
+  165   mkImage screenWidth screenHeight . prerenderSvgFile key pWidth pHeight
+  166 
+  167 
+  168 {-# INLINE embedImage #-}
+  169 -- | Embed an in-memory PNG image. Note, the pixel size of the image
+  170 --   is used as the dimensions. As such, embedding a 100x100 PNG will
+  171 --   result in an image 100 units wide and 100 units high. Consider
+  172 --   using with 'scaleToSize'.
+  173 embedImage :: PngSavable a => Image a -> SVG
+  174 embedImage img = embedPng width height (encodePng img)
+  175  where
+  176   width  = fromIntegral $ imageWidth img
+  177   height = fromIntegral $ imageHeight img
+  178 
+  179 -- | Embed in-memory PNG bytestring without parsing it.
+  180 embedPng
+  181   :: Double -- ^ Width
+  182   -> Double -- ^ Height
+  183   -> LBS.ByteString -- ^ Raw PNG data
+  184   -> SVG
+  185 -- embedPng w h png = unsafePerformIO $ do
+  186 --     LBS.writeFile path png
+  187 --     return $ ImageTree $ defaultSvg
+  188 --       & Svg.imageCornerUpperLeft .~ (Svg.Num (-w/2), Svg.Num (-h/2))
+  189 --       & Svg.imageWidth .~ Svg.Num w
+  190 --       & Svg.imageHeight .~ Svg.Num h
+  191 --       & Svg.imageHref .~ ("file://"++path)
+  192 --   where
+  193 --     path = "/tmp" </> show (hash png) <.> "png"
+  194 embedPng w h png =
+  195   flipYAxis
+  196     $  Svg.imageTree
+  197     $  defaultSvg
+  198     &  Svg.imageCornerUpperLeft
+  199     .~ (Svg.Num (-w / 2), Svg.Num (-h / 2))
+  200     &  Svg.imageWidth
+  201     .~ Svg.Num w
+  202     &  Svg.imageHeight
+  203     .~ Svg.Num h
+  204     &  Svg.imageHref
+  205     .~ ("data:image/png;base64," ++ imgData)
+  206   where imgData = LBS.unpack $ Base64.encode png
+  207 
+  208 
+  209 {-# INLINE embedDynamicImage #-}
+  210 -- | Embed an in-memory image. Note, the pixel size of the image
+  211 --   is used as the dimensions. As such, embedding a 100x100 image will
+  212 --   result in an image 100 units wide and 100 units high. Consider
+  213 --   using with 'scaleToSize'.
+  214 embedDynamicImage :: DynamicImage -> SVG
+  215 embedDynamicImage img = embedPng width height imgData
+  216  where
+  217   width   = fromIntegral $ dynamicMap imageWidth img
+  218   height  = fromIntegral $ dynamicMap imageHeight img
+  219   imgData = case encodeDynamicPng img of
+  220     Left  err -> error err
+  221     Right dat -> dat
+  222 
+  223 -- embedImageFile :: FilePath -> Tree
+  224 -- embedImageFile path = unsafePerformIO $ do
+  225 --     png <- B.readFile path
+  226 --     case decodePng png of
+  227 --       Left{}    -> error "bad image"
+  228 --       Right img -> return $
+  229 --         let width   = fromIntegral $ dynamicMap imageWidth img
+  230 --             height  = fromIntegral $ dynamicMap imageHeight img in
+  231 --         ImageTree $ defaultSvg
+  232 --           & Svg.imageCornerUpperLeft .~ (Svg.Num (-width/2), Svg.Num (-height/2))
+  233 --           & Svg.imageWidth .~ Svg.Num width
+  234 --           & Svg.imageHeight .~ Svg.Num height
+  235 --           & Svg.imageHref .~ ("file://" ++ path)
+  236 
+  237 
+  238 -- | Convert an SVG object to a pixel-based image. The default resolution
+  239 --   is 2560x1440. See also 'rasterSized'. Multiple raster engines are supported
+  240 --   and are selected using the '--raster' flag in the driver.
+  241 raster :: SVG -> DynamicImage
+  242 raster = rasterSized 2560 1440
+  243 
+  244 -- | Convert an SVG object to a pixel-based image.
+  245 rasterSized
+  246   :: Width  -- ^ X resolution in pixels
+  247   -> Height -- ^ Y resolution in pixels
+  248   -> SVG    -- ^ SVG object
+  249   -> DynamicImage
+  250 rasterSized w h svg = unsafePerformIO $ do
+  251   png <- B.readFile (svgAsPngFile' w h svg)
+  252   case decodePng png of
+  253     Left{}    -> error "bad image"
+  254     Right img -> return img
+  255 
+  256 -- | Use \'potrace\' to trace edges in a raster image and convert them to SVG polygons.
+  257 vectorize :: FilePath -> SVG
+  258 vectorize = vectorize_ []
+  259 
+  260 -- | Same as 'vectorize' but takes a list of arguments for \'potrace\'.
+  261 vectorize_ :: [String] -> FilePath -> SVG
+  262 vectorize_ _ path | pNoExternals = mkText $ T.pack path
+  263 vectorize_ args path             = unsafePerformIO $ do
+  264   root <- getXdgDirectory XdgCache "reanimate"
+  265   createDirectoryIfMissing True root
+  266   let svgPath = root </> encodeInt key <.> "svg"
+  267   hit <- doesFileExist svgPath
+  268   unless hit $ withSystemTempFile "file.svg" $ \tmpSvgPath svgH ->
+  269     withSystemTempFile "file.bmp" $ \tmpBmpPath bmpH -> do
+  270       hClose svgH
+  271       hClose bmpH
+  272       potrace <- requireExecutable "potrace"
+  273       magick <- requireExecutable magickCmd
+  274       runCmd magick [path, "-flatten", tmpBmpPath]
+  275       runCmd potrace (args ++ ["--svg", "--output", tmpSvgPath, tmpBmpPath])
+  276       renameOrCopyFile tmpSvgPath svgPath
+  277   svg_data <- B.readFile svgPath
+  278   case parseSvgFile svgPath svg_data of
+  279     Nothing -> do
+  280       removeFile svgPath
+  281       error "Malformed svg"
+  282     Just svg -> return $ unbox $ replaceUses svg
+  283   where key = hash (path, args)
+  284 
+  285 -- imageAsFile :: DynamicImage -> FilePath
+  286 -- imageAsFile img
+  287 
+  288 -- | Convert an SVG object to a pixel-based image and save it to disk, returning
+  289 --   the filepath. The default resolution is 2560x1440. See also 'svgAsPngFile''.
+  290 --   Multiple raster engines are supported and are selected using the '--raster'
+  291 --   flag in the driver.
+  292 svgAsPngFile :: SVG -> FilePath
+  293 svgAsPngFile = svgAsPngFile' width height
+  294  where
+  295   width  = 2560
+  296   height = width * 9 `div` 16
+  297 
+  298 -- | Convert an SVG object to a pixel-based image and save it to disk, returning
+  299 --   the filepath.
+  300 svgAsPngFile'
+  301   :: Width  -- ^ Width
+  302   -> Height -- ^ Height
+  303   -> SVG    -- ^ SVG object
+  304   -> FilePath
+  305 svgAsPngFile' _ _ _ | pNoExternals = "/svgAsPngFile/has/been/disabled"
+  306 svgAsPngFile' width height svg =
+  307   unsafePerformIO $ cacheFile template $ \pngPath -> do
+  308     let svgPath = replaceExtension pngPath "svg"
+  309     writeFile svgPath rendered
+  310     engine <- requireRaster pRaster
+  311     applyRaster engine svgPath
+  312  where
+  313   template = encodeInt (hash rendered) <.> "png"
+  314   rendered = renderSvg (Just $ Px $ fromIntegral width)
+  315                        (Just $ Px $ fromIntegral height)
+  316                        svg
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Render.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Render.hs.html new file mode 100644 index 0000000..861b697 --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Render.hs.html @@ -0,0 +1,445 @@ + + + + + + +
+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   , renderLimitedFrames
+   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   handle errHandler $ concurrentForM_ (frameOrder rate frameCount) $ \nth' -> do
+   67     let nth = (nth'+offset) `mod` frameCount
+   68         now = (duration ani / (fromIntegral frameCount - 1)) * fromIntegral nth
+   69         frame = frameAt (if frameCount <= 1 then 0 else now) ani
+   70         path = folder </> show nth <.> "svg"
+   71         svg = renderSvg Nothing Nothing frame
+   72 
+   73     idempotentFile path $
+   74       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 -- | Render as many frames as possible in 2 seconds. Limited to 20 frames.
+   86 renderLimitedFrames :: FilePath -> Int -> Bool -> Int -> Animation -> IO ()
+   87 renderLimitedFrames folder offset _prettyPrint rate ani = do
+   88     now <- getCurrentTime
+   89     worker (addUTCTime timeLimit now) frameLimit (frameOrder rate frameCount)
+   90   where
+   91     timeLimit = 2
+   92     frameLimit = 20 :: Int
+   93     worker _ 0 _ = return ()
+   94     worker _ _ [] = putStrLn "Done"
+   95     worker localTimeLimit l (x:xs) = do
+   96       curTime <- getCurrentTime
+   97       if curTime > localTimeLimit
+   98         then return ()
+   99         else do
+  100           let nth = (x+offset) `mod` frameCount
+  101               now = (duration ani / (fromIntegral frameCount - 1)) * fromIntegral nth
+  102               frame = frameAt (if frameCount <= 1 then 0 else now) ani
+  103               svg = renderSvg Nothing Nothing frame
+  104               path = folder </> show nth <.> "svg"
+  105               tmpPath = path <.> "tmp"
+  106           haveFile <- doesFileExist path
+  107           if haveFile
+  108             then worker localTimeLimit l xs
+  109             else do
+  110               writeFile tmpPath svg
+  111               renameOrCopyFile tmpPath path
+  112               print nth
+  113               worker localTimeLimit (l-1) xs
+  114     frameCount = round (duration ani * fromIntegral rate) :: Int
+  115 
+  116 -- XXX: Merge with 'renderSvgs'
+  117 -- | Render 10 frames and print them to stdout. Used for testing.
+  118 --
+  119 --   XXX: Not related to the snippets in the playground.
+  120 renderSnippets :: Animation -> IO ()
+  121 renderSnippets ani = forM_ [0 .. frameCount - 1] $ \nth -> do
+  122   let now   = (duration ani / (fromIntegral frameCount - 1)) * fromIntegral nth
+  123       frame = frameAt now ani
+  124       svg   = renderSvg Nothing Nothing frame
+  125   putStr (show nth)
+  126   T.putStrLn $ T.concat . T.lines . T.pack $ svg
+  127   where frameCount = 10 :: Integer
+  128 
+  129 frameOrder :: Int -> Int -> [Int]
+  130 frameOrder fps nFrames = worker [] fps
+  131  where
+  132   worker _seen 0        = []
+  133   worker seen  nthFrame = filterFrameList seen nthFrame nFrames
+  134     ++ worker (nthFrame : seen) (nthFrame `div` 2)
+  135 
+  136 filterFrameList :: [Int] -> Int -> Int -> [Int]
+  137 filterFrameList seen nthFrame nFrames = filter (not . isSeen)
+  138                                                [0, nthFrame .. nFrames - 1]
+  139   where isSeen x = any (\y -> x `mod` y == 0) seen
+  140 
+  141 -- | Video formats supported by reanimate.
+  142 data Format = RenderMp4 | RenderGif | RenderWebm
+  143   deriving (Show)
+  144 
+  145 mp4Arguments :: FPS -> FilePath -> FilePath -> FilePath -> [String]
+  146 mp4Arguments fps progress template target =
+  147   [ "-r"
+  148   , show fps
+  149   , "-i"
+  150   , template
+  151   , "-y"
+  152   , "-c:v"
+  153   , "libx264"
+  154   , "-vf"
+  155   , "fps=" ++ show fps
+  156   , "-preset"
+  157   , "slow"
+  158   , "-crf"
+  159   , "18"
+  160   , "-movflags"
+  161   , "+faststart"
+  162   , "-progress"
+  163   , progress
+  164   , "-pix_fmt"
+  165   , "yuv420p"
+  166   , target
+  167   ]
+  168 
+  169 -- gifArguments :: FPS -> FilePath -> FilePath -> FilePath -> [String]
+  170 -- gifArguments fps progress template target =
+  171 
+  172 -- | Render animation to a video file with given parameters.
+  173 render
+  174   :: Animation
+  175   -> FilePath
+  176   -> Raster
+  177   -> Format
+  178   -> Width
+  179   -> Height
+  180   -> FPS
+  181   -> Bool
+  182   -> IO ()
+  183 render ani target raster format width height fps partial = do
+  184   printf "Starting render of animation: %.1f\n" (duration ani)
+  185   ffmpeg <- requireExecutable "ffmpeg"
+  186   generateFrames raster ani width height fps partial $ \template ->
+  187     withTempFile "txt" $ \progress -> do
+  188       writeFile progress ""
+  189       progressH <- openFile progress ReadMode
+  190       hSetBuffering progressH NoBuffering
+  191       allFinished <- newEmptyMVar
+  192       void $ forkIO $ do
+  193         progressPrinter "rendered" (animationFrameCount ani fps)
+  194           $ \done -> fix $ \loop -> do
+  195             eof <- hIsEOF progressH
+  196             if eof
+  197               then threadDelay 1000000 >> loop
+  198               else do
+  199                 l <- try (hGetLine progressH)
+  200                 case l of
+  201                   Left  SomeException{} -> return ()
+  202                   Right str             ->
+  203                     case take 6 str of
+  204                       "frame=" -> do
+  205                         void $ swapMVar done (read (drop 6 str))
+  206                         loop
+  207                       _ | str == "progress=end" -> return ()
+  208                       _                         -> loop
+  209         putMVar allFinished ()
+  210       case format of
+  211         RenderMp4 -> runCmd ffmpeg (mp4Arguments fps progress template target)
+  212         RenderGif -> withTempFile "png" $ \palette -> do
+  213           runCmd
+  214             ffmpeg
+  215             [ "-i"
+  216             , template
+  217             , "-y"
+  218             , "-vf"
+  219             , "fps="
+  220             ++ show fps
+  221             ++ ",scale="
+  222             ++ show width
+  223             ++ ":"
+  224             ++ show height
+  225             ++ ":flags=lanczos,palettegen"
+  226             , "-t"
+  227             , showFFloat Nothing (duration ani) ""
+  228             , palette
+  229             ]
+  230           runCmd
+  231             ffmpeg
+  232             [ "-framerate"
+  233             , show fps
+  234             , "-i"
+  235             , template
+  236             , "-y"
+  237             , "-i"
+  238             , palette
+  239             , "-progress"
+  240             , progress
+  241             , "-filter_complex"
+  242             , "fps="
+  243             ++ show fps
+  244             ++ ",scale="
+  245             ++ show width
+  246             ++ ":"
+  247             ++ show height
+  248             ++ ":flags=lanczos[x];[x][1:v]paletteuse"
+  249             , "-t"
+  250             , showFFloat Nothing (duration ani) ""
+  251             , target
+  252             ]
+  253         RenderWebm -> runCmd
+  254           ffmpeg
+  255           [ "-r"
+  256           , show fps
+  257           , "-i"
+  258           , template
+  259           , "-y"
+  260           , "-progress"
+  261           , progress
+  262           , "-c:v"
+  263           , "libvpx-vp9"
+  264           , "-vf"
+  265           , "fps=" ++ show fps
+  266           , target
+  267           ]
+  268       takeMVar allFinished
+  269 
+  270 ---------------------------------------------------------------------------------
+  271 -- Helpers
+  272 
+  273 progressPrinter :: String -> Int -> (MVar Int -> IO ()) -> IO ()
+  274 progressPrinter typeName maxCount action = do
+  275   printf "\rFrames %s: 0/%d" typeName maxCount
+  276   putStr $ clearFromCursorToLineEndCode ++ "\r"
+  277   done  <- newMVar (0 :: Int)
+  278   start <- getCurrentTime
+  279   let bgThread = forever $ do
+  280         nDone <- readMVar done
+  281         now   <- getCurrentTime
+  282         let spent = diffUTCTime now start
+  283             remaining =
+  284               (spent / (fromIntegral nDone / fromIntegral maxCount)) - spent
+  285         printf "\rFrames %s: %d/%d" typeName nDone maxCount
+  286         putStr $ ", time spent: " ++ ppDiff spent
+  287         unless (nDone == 0) $ do
+  288           putStr $ ", time remaining: " ++ ppDiff remaining
+  289           putStr $ ", total time: " ++ ppDiff (remaining + spent)
+  290         putStr $ clearFromCursorToLineEndCode ++ "\r"
+  291         hFlush stdout
+  292         threadDelay 1000000
+  293   withBackgroundThread bgThread $ action done
+  294   now <- getCurrentTime
+  295   let spent = diffUTCTime now start
+  296   printf "\rFrames %s: %d/%d" typeName maxCount maxCount
+  297   putStr $ ", time spent: " ++ ppDiff spent
+  298   putStr $ clearFromCursorToLineEndCode ++ "\n"
+  299 
+  300 animationFrameCount :: Animation -> FPS -> Int
+  301 animationFrameCount ani rate = round (duration ani * fromIntegral rate) :: Int
+  302 
+  303 generateFrames
+  304   :: Raster -> Animation -> Width -> Height -> FPS -> Bool -> (FilePath -> IO a) -> IO a
+  305 generateFrames raster ani width_ height_ rate partial action = withTempDir $ \tmp -> do
+  306   let frameName nth = tmp </> printf nameTemplate nth
+  307   setRootDirectory tmp
+  308   progressPrinter "generated" frameCount
+  309     $ \done -> handle h $ concurrentForM_ frames $ \n -> do
+  310         writeFile (frameName n) $ renderSvg width height $ nthFrame n
+  311         modifyMVar_ done $ \nDone -> return (nDone + 1)
+  312 
+  313   when (isValidRaster raster)
+  314     $ progressPrinter "rastered" frameCount
+  315     $ \done -> handle h $ concurrentForM_ frames $ \n -> do
+  316         applyRaster raster (frameName n)
+  317         modifyMVar_ done $ \nDone -> return (nDone + 1)
+  318 
+  319   action (tmp </> rasterTemplate raster)
+  320  where
+  321   isValidRaster RasterNone = False
+  322   isValidRaster RasterAuto = False
+  323   isValidRaster _          = True
+  324 
+  325   width  = Just $ Px $ fromIntegral width_
+  326   height = Just $ Px $ fromIntegral height_
+  327   h UserInterrupt | partial = do
+  328     hPutStrLn
+  329       stderr
+  330       "\nCtrl-C detected. Trying to generate video with available frames. \
+  331                        \Hit ctrl-c again to abort."
+  332     return ()
+  333   h other = throwIO other
+  334   -- frames = [0..frameCount-1]
+  335   frames = frameOrder rate frameCount
+  336   nthFrame nth = frameAt (recip (fromIntegral rate) * fromIntegral nth) ani
+  337   frameCount = animationFrameCount ani rate
+  338   nameTemplate :: String
+  339   nameTemplate = "render-%05d.svg"
+  340 
+  341 withBackgroundThread :: IO () -> IO a -> IO a
+  342 withBackgroundThread t = bracket (forkIO t) killThread . const
+  343 
+  344 ppDiff :: NominalDiffTime -> String
+  345 ppDiff diff | hours == 0 && mins == 0 = show secs ++ "s"
+  346             | hours == 0              = printf "%.2d:%.2d" mins secs
+  347             | otherwise               = printf "%.2d:%.2d:%.2d" hours mins secs
+  348  where
+  349   (osecs, secs) = round diff `divMod` (60 :: Int)
+  350   (hours, mins) = osecs `divMod` 60
+  351 
+  352 rasterTemplate :: Raster -> String
+  353 rasterTemplate RasterNone = "render-%05d.svg"
+  354 rasterTemplate RasterAuto = "render-%05d.svg"
+  355 rasterTemplate _          = "render-%05d.png"
+  356 
+  357 -- | Resolve RasterNone and RasterAuto. If no valid raster can
+  358 --   be found, exit with an error message.
+  359 requireRaster :: Raster -> IO Raster
+  360 requireRaster raster = do
+  361   raster' <- selectRaster (if raster == RasterNone then RasterAuto else raster)
+  362   case raster' of
+  363     RasterNone -> do
+  364       hPutStrLn
+  365         stderr
+  366         "Raster required but none could be found. \
+  367         \Please install either inkscape, imagemagick, or rsvg-convert."
+  368       exitWith (ExitFailure 1)
+  369     _ -> pure raster'
+  370 
+  371 -- | Resolve RasterNone and RasterAuto. If no valid raster can
+  372 --   be found, return RasterNone.
+  373 selectRaster :: Raster -> IO Raster
+  374 selectRaster RasterAuto = do
+  375   rsvg   <- hasRSvg
+  376   ink    <- hasInkscape
+  377   magick <- hasMagick
+  378   if
+  379     | isRight rsvg   -> pure RasterRSvg
+  380     | isRight ink    -> pure RasterInkscape
+  381     | isRight magick -> pure RasterMagick
+  382     | otherwise      -> pure RasterNone
+  383 selectRaster r = pure r
+  384 
+  385 -- | Convert SVG file to a PNG file with selected raster engine. If
+  386 --   raster engine is RasterAuto or RasterNone, do nothing.
+  387 applyRaster :: Raster -> FilePath -> IO ()
+  388 applyRaster RasterNone     _    = return ()
+  389 applyRaster RasterAuto     _    = return ()
+  390 applyRaster RasterInkscape path = runCmd
+  391   "inkscape"
+  392   [ "--without-gui"
+  393   , "--file=" ++ path
+  394   , "--export-png=" ++ replaceExtension path "png"
+  395   ]
+  396 applyRaster RasterRSvg path = runCmd
+  397   "rsvg-convert"
+  398   [path, "--unlimited", "--output", replaceExtension path "png"]
+  399 applyRaster RasterMagick path =
+  400   runCmd magickCmd [path, replaceExtension path "png"]
+  401 
+  402 concurrentForM_ :: [a] -> (a -> IO ()) -> IO ()
+  403 concurrentForM_ lst action = do
+  404   n    <- getNumCapabilities
+  405   sem  <- newQSemN n
+  406   eVar <- newEmptyMVar
+  407   forM_ lst $ \elt -> do
+  408     waitQSemN sem 1
+  409     emp <- isEmptyMVar eVar
+  410     if emp
+  411       then
+  412         void
+  413           $ forkIO
+  414               (         catch       (action elt) (void . tryPutMVar eVar)
+  415               `finally` signalQSemN sem          1
+  416               )
+  417       else signalQSemN sem 1
+  418   waitQSemN sem n
+  419   mbE <- tryTakeMVar eVar
+  420   case mbE of
+  421     Nothing -> return ()
+  422     Just e  -> throwIO (e :: SomeException)
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Scene.Core.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Scene.Core.hs.html new file mode 100644 index 0000000..d591145 --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Scene.Core.hs.html @@ -0,0 +1,183 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE RankNTypes #-}
+    2 
+    3 module Reanimate.Scene.Core where
+    4 
+    5 import Control.Monad.Fix (MonadFix (..))
+    6 import Control.Monad.ST
+    7 import Data.List
+    8 import Reanimate.Animation
+    9 import Reanimate.Svg.Constructors
+   10 
+   11 -- | The ZIndex property specifies the stack order of sprites and animations. Elements
+   12 --   with a higher ZIndex will be drawn on top of elements with a lower index.
+   13 type ZIndex = Int
+   14 
+   15 -- (seq duration, par duration)
+   16 -- [(Time, Animation, ZIndex)]
+   17 -- Map Time [(Animation, ZIndex)]
+   18 type Gen s = ST s (Duration -> Time -> (SVG, ZIndex))
+   19 
+   20 -- | A 'Scene' represents a sequence of animations and variables
+   21 --   that change over time.
+   22 newtype Scene s a = M {unM :: Time -> ST s (a, Duration, Duration, [Gen s])}
+   23 
+   24 instance Functor (Scene s) where
+   25   fmap f action = M $ \t -> do
+   26     (a, d1, d2, gens) <- unM action t
+   27     return (f a, d1, d2, gens)
+   28 
+   29 instance Applicative (Scene s) where
+   30   pure a = M $ \_ -> return (a, 0, 0, [])
+   31   f <*> g = M $ \t -> do
+   32     (f', s1, p1, gen1) <- unM f t
+   33     (g', s2, p2, gen2) <- unM g (t + s1)
+   34     return (f' g', s1 + s2, max p1 (s1 + p2), gen1 ++ gen2)
+   35 
+   36 instance Monad (Scene s) where
+   37   return = pure
+   38   f >>= g = M $ \t -> do
+   39     (a, s1, p1, gen1) <- unM f t
+   40     (b, s2, p2, gen2) <- unM (g a) (t + s1)
+   41     return (b, s1 + s2, max p1 (s1 + p2), gen1 ++ gen2)
+   42 
+   43 instance MonadFix (Scene s) where
+   44   mfix fn = M $ \t -> mfix (\v -> let (a, _s, _p, _gens) = v in unM (fn a) t)
+   45 
+   46 -- | Lift ST action into the Scene monad.
+   47 liftST :: ST s a -> Scene s a
+   48 liftST action = M $ \_ -> action >>= \a -> return (a, 0, 0, [])
+   49 
+   50 -- | Evaluate the value of a scene.
+   51 evalScene :: (forall s. Scene s a) -> a
+   52 evalScene action = runST $ do
+   53   (val, _, _, _) <- unM action 0
+   54   return val
+   55 
+   56 -- | Render a 'Scene' to an 'Animation'.
+   57 scene :: (forall s. Scene s a) -> Animation
+   58 scene action =
+   59   runST
+   60     ( do
+   61         (_, s, p, gens) <- unM action 0
+   62         let dur = max s p
+   63         genFns <- sequence gens
+   64         return $
+   65           mkAnimation
+   66             dur
+   67             ( \t ->
+   68                 mkGroup $
+   69                   map fst $
+   70                     sortOn
+   71                       snd
+   72                       [spriteRender dur (t * dur) | spriteRender <- genFns]
+   73             )
+   74     )
+   75 
+   76 -- | Execute actions in a scene without advancing the clock. Note that scenes do not end before
+   77 --   all forked actions have completed.
+   78 --
+   79 --   Example:
+   80 --
+   81 -- @
+   82 -- do 'fork' $ 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawBox'
+   83 --    'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle'
+   84 -- @
+   85 --
+   86 --   <<docs/gifs/doc_fork.gif>>
+   87 fork :: Scene s a -> Scene s a
+   88 fork (M action) = M $ \t -> do
+   89   (a, s, p, gens) <- action t
+   90   return (a, 0, max s p, gens)
+   91 
+   92 -- | Query the current clock timestamp.
+   93 --
+   94 --   Example:
+   95 --
+   96 -- @
+   97 -- do now \<- 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle' *\> 'queryNow'
+   98 --    'Reanimate.Scene.play' $ 'staticFrame' 1 $ 'scale' 2 $ 'withStrokeWidth' 0.05 $
+   99 --      'mkText' $ "Now=" <> T.pack (show now)
+  100 -- @
+  101 --
+  102 --   <<docs/gifs/doc_queryNow.gif>>
+  103 queryNow :: Scene s Time
+  104 queryNow = M $ \t -> return (t, 0, 0, [])
+  105 
+  106 -- | Advance the clock by a given number of seconds.
+  107 --
+  108 --   Example:
+  109 --
+  110 -- @
+  111 -- do 'fork' $ 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawBox'
+  112 --    'wait' 1
+  113 --    'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle'
+  114 -- @
+  115 --
+  116 --   <<docs/gifs/doc_wait.gif>>
+  117 wait :: Duration -> Scene s ()
+  118 wait d = M $ \_ -> return ((), d, 0, [])
+  119 
+  120 -- | Wait until the clock is equal to the given timestamp.
+  121 waitUntil :: Time -> Scene s ()
+  122 waitUntil tNew = do
+  123   now <- queryNow
+  124   wait (max 0 (tNew - now))
+  125 
+  126 -- | Wait until all forked and sequential animations have finished.
+  127 --
+  128 --   Example:
+  129 --
+  130 -- @
+  131 -- do 'waitOn' $ 'fork' $ 'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawBox'
+  132 --    'Reanimate.Scene.play' 'Reanimate.Builtin.Documentation.drawCircle'
+  133 -- @
+  134 --
+  135 --   <<docs/gifs/doc_waitOn.gif>>
+  136 waitOn :: Scene s a -> Scene s a
+  137 waitOn (M action) = M $ \t -> do
+  138   (a, s, p, gens) <- action t
+  139   return (a, max s p, 0, gens)
+  140 
+  141 -- | Change the ZIndex of a scene.
+  142 adjustZ :: (ZIndex -> ZIndex) -> Scene s a -> Scene s a
+  143 adjustZ fn (M action) = M $ \t -> do
+  144   (a, s, p, gens) <- action t
+  145   return (a, s, p, map genFn gens)
+  146   where
+  147     genFn gen = do
+  148       frameGen <- gen
+  149       return $ \d t -> let (svg, z) = frameGen d t in (svg, fn z)
+  150 
+  151 -- | Query the duration of a scene.
+  152 withSceneDuration :: Scene s () -> Scene s Duration
+  153 withSceneDuration s = do
+  154   t1 <- queryNow
+  155   s
+  156   t2 <- queryNow
+  157   return (t2 - t1)
+  158 
+  159 addGen :: Gen s -> Scene s ()
+  160 addGen gen = M $ \_ -> return ((), 0, 0, [gen])
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Scene.Sprite.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Scene.Sprite.hs.html new file mode 100644 index 0000000..ce2281a --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Scene.Sprite.hs.html @@ -0,0 +1,439 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE ApplicativeDo #-}
+    2 {-# LANGUAGE PatternSynonyms #-}
+    3 {-# LANGUAGE RankNTypes #-}
+    4 
+    5 module Reanimate.Scene.Sprite where
+    6 
+    7 import Control.Monad (void)
+    8 import Control.Monad.ST (ST)
+    9 import Data.Bifunctor (Bifunctor (first))
+   10 import Data.STRef (STRef, modifySTRef, newSTRef, readSTRef)
+   11 import Graphics.SvgTree
+   12   ( pattern None,
+   13   )
+   14 import Reanimate.Animation
+   15   ( Animation,
+   16     Duration,
+   17     SVG,
+   18     Sync (SyncStretch),
+   19     Time,
+   20     dropA,
+   21     duration,
+   22     getAnimationFrame,
+   23   )
+   24 import Reanimate.Effect (Effect, delayE)
+   25 import Reanimate.Scene.Core
+   26   ( Scene (M),
+   27     ZIndex,
+   28     addGen,
+   29     fork,
+   30     liftST,
+   31     queryNow,
+   32     scene,
+   33     wait,
+   34   )
+   35 import Reanimate.Scene.Var (unpackVar, Var (..), newVar, readVar)
+   36 import Reanimate.Transition (Transition, overlapT)
+   37 
+   38 -- | Create and render a variable. The rendering will be born at the current timestamp
+   39 --   and will persist until the end of the scene.
+   40 --
+   41 --   Example:
+   42 --
+   43 -- @
+   44 -- do var \<- 'simpleVar' 'Reanimate.Svg.Constructors.mkCircle' 0
+   45 --    'Reanimate.Scene.tweenVar' var 2 $ \\val -> 'Reanimate.fromToS' val ('Reanimate.Constants.screenHeight'/2)
+   46 -- @
+   47 --
+   48 --   <<docs/gifs/doc_simpleVar.gif>>
+   49 simpleVar :: (a -> SVG) -> a -> Scene s (Var s a)
+   50 simpleVar render def = do
+   51   v <- newVar def
+   52   _ <- newSprite $ render <$> unVar v
+   53   return v
+   54 
+   55 -- | Helper function for filtering variables.
+   56 findVar :: (a -> Bool) -> [Var s a] -> Scene s (Var s a)
+   57 findVar _cond [] = error "Variable not found."
+   58 findVar cond (v : vs) = do
+   59   val <- readVar v
+   60   if cond val then return v else findVar cond vs
+   61 
+   62 -- | Play an animation once and then remove it. This advances the clock by the duration of the
+   63 --   animation.
+   64 --
+   65 --   Example:
+   66 --
+   67 -- @
+   68 -- do 'play' 'Reanimate.Builtin.Documentation.drawBox'
+   69 --    'play' 'Reanimate.Builtin.Documentation.drawCircle'
+   70 -- @
+   71 --
+   72 --   <<docs/gifs/doc_play.gif>>
+   73 play :: Animation -> Scene s ()
+   74 play ani = newSpriteA ani >>= destroySprite
+   75 
+   76 -- | Sprites are animations with a given time of birth as well as a time of death.
+   77 --   They can be controlled using variables, tweening, and effects.
+   78 data Sprite s = Sprite Time (STRef s (Duration, ST s (Duration -> Time -> SVG -> (SVG, ZIndex))))
+   79 
+   80 -- | Sprite frame generator. Generates frames over time in a stateful environment.
+   81 newtype Frame s a = Frame {unFrame :: ST s (Time -> Duration -> Time -> a)}
+   82 
+   83 instance Functor (Frame s) where
+   84   fmap fn (Frame gen) = Frame $ do
+   85     m <- gen
+   86     return (\real_t d t -> fn $ m real_t d t)
+   87 
+   88 instance Applicative (Frame s) where
+   89   pure v = Frame $ return (\_ _ _ -> v)
+   90   Frame f <*> Frame g = Frame $ do
+   91     m1 <- f
+   92     m2 <- g
+   93     return $ \real_t d t -> m1 real_t d t (m2 real_t d t)
+   94 
+   95 -- | Dereference a variable as a Sprite frame.
+   96 --
+   97 --   Example:
+   98 --
+   99 -- @
+  100 -- do v \<- 'newVar' 0
+  101 --    'newSprite' $ 'Reanimate.Svg.Constructors.mkCircle' \<$\> 'unVar' v
+  102 --    'Reanimate.Scene.tweenVar' v 1 $ \\val -> 'Reanimate.fromToS' val 3
+  103 --    'Reanimate.Scene.tweenVar' v 1 $ \\val -> 'Reanimate.fromToS' val 0
+  104 -- @
+  105 --
+  106 --   <<docs/gifs/doc_unVar.gif>>
+  107 unVar :: Var s a -> Frame s a
+  108 unVar var = Frame $ do
+  109   fn <- unpackVar var
+  110   return $ \real_t _d _t -> fn real_t
+  111 
+  112 -- | Dereference seconds since sprite birth.
+  113 spriteT :: Frame s Time
+  114 spriteT = Frame $ return (\_real_t _d t -> t)
+  115 
+  116 -- | Dereference duration of the current sprite.
+  117 spriteDuration :: Frame s Duration
+  118 spriteDuration = Frame $ return (\_real_t d _t -> d)
+  119 
+  120 -- | Create new sprite defined by a frame generator. Unless otherwise specified using
+  121 --   'destroySprite', the sprite will die at the end of the scene.
+  122 --
+  123 --   Example:
+  124 --
+  125 -- @
+  126 -- do 'newSprite' $ 'Reanimate.Svg.Constructors.mkCircle' \<$\> 'spriteT' -- Circle sprite where radius=time.
+  127 --    'wait' 2
+  128 -- @
+  129 --
+  130 --   <<docs/gifs/doc_newSprite.gif>>
+  131 newSprite :: Frame s SVG -> Scene s (Sprite s)
+  132 newSprite render = do
+  133   now <- queryNow
+  134   ref <- liftST $ newSTRef (-1, return $ \_d _t svg -> (svg, 0))
+  135   addGen $ do
+  136     fn <- unFrame render
+  137     (spriteDur, spriteEffectGen) <- readSTRef ref
+  138     spriteEffect <- spriteEffectGen
+  139     return $ \d absT ->
+  140       let relD = (if spriteDur < 0 then d else spriteDur) - now
+  141           relT = absT - now
+  142           -- Sprite is live [now;duration[
+  143           -- If we're at the end of a scene, sprites
+  144           -- are live: [now;duration]
+  145           -- This behavior is difficult to get right. See the 'bug_*' examples for
+  146           -- automated tests.
+  147           inTimeSlice = relT >= 0 && relT < relD
+  148           isLastFrame = d == absT && relT == relD
+  149        in if inTimeSlice || isLastFrame
+  150             then spriteEffect relD relT (fn absT relD relT)
+  151             else (None, 0)
+  152   return $ Sprite now ref
+  153 
+  154 -- | Create new sprite defined by a frame generator. The sprite will die at
+  155 --   the end of the scene.
+  156 newSprite_ :: Frame s SVG -> Scene s ()
+  157 newSprite_ = void . newSprite
+  158 
+  159 -- | Create a new sprite from an animation. This advances the clock by the
+  160 --   duration of the animation. Unless otherwise specified using
+  161 --   'destroySprite', the sprite will die at the end of the scene.
+  162 --
+  163 --   Note: If the scene doesn't end immediately after the duration of the
+  164 --   animation, the animation will be stretched to match the lifetime of the
+  165 --   sprite. See 'newSpriteA'' and 'play'.
+  166 --
+  167 --   Example:
+  168 --
+  169 -- @
+  170 -- do 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle'
+  171 --    'play' 'Reanimate.Builtin.Documentation.drawBox'
+  172 --    'play' $ 'Reanimate.Animation.reverseA' 'Reanimate.Builtin.Documentation.drawBox'
+  173 -- @
+  174 --
+  175 --   <<docs/gifs/doc_newSpriteA.gif>>
+  176 newSpriteA :: Animation -> Scene s (Sprite s)
+  177 newSpriteA = newSpriteA' SyncStretch
+  178 
+  179 -- | Create a new sprite from an animation and specify the synchronization policy. This advances
+  180 --   the clock by the duration of the animation.
+  181 --
+  182 --   Example:
+  183 --
+  184 -- @
+  185 -- do 'fork' $ 'newSpriteA'' 'Reanimate.Animation.SyncFreeze' 'Reanimate.Builtin.Documentation.drawCircle'
+  186 --    'play' 'Reanimate.Builtin.Documentation.drawBox'
+  187 --    'play' $ 'Reanimate.Animation.reverseA' 'Reanimate.Builtin.Documentation.drawBox'
+  188 -- @
+  189 --
+  190 --   <<docs/gifs/doc_newSpriteA'.gif>>
+  191 newSpriteA' :: Sync -> Animation -> Scene s (Sprite s)
+  192 newSpriteA' sync animation =
+  193   newSprite (getAnimationFrame sync animation <$> spriteT <*> spriteDuration)
+  194     <* wait (duration animation)
+  195 
+  196 -- | Create a sprite from a static SVG image.
+  197 --
+  198 --   Example:
+  199 --
+  200 -- @
+  201 -- do 'newSpriteSVG' $ 'Reanimate.Svg.Constructors.mkBackground' "lightblue"
+  202 --    'play' 'Reanimate.Builtin.Documentation.drawCircle'
+  203 -- @
+  204 --
+  205 --   <<docs/gifs/doc_newSpriteSVG.gif>>
+  206 newSpriteSVG :: SVG -> Scene s (Sprite s)
+  207 newSpriteSVG = newSprite . pure
+  208 
+  209 -- | Create a permanent sprite from a static SVG image. Same as `newSpriteSVG`
+  210 --   but the sprite isn't returned and thus cannot be destroyed.
+  211 newSpriteSVG_ :: SVG -> Scene s ()
+  212 newSpriteSVG_ = void . newSpriteSVG
+  213 
+  214 -- | Change the rendering of a sprite using data from a variable. If data from several variables
+  215 --   is needed, use a frame generator instead.
+  216 --
+  217 --   Example:
+  218 --
+  219 -- @
+  220 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawBox'
+  221 --    v \<- 'newVar' 0
+  222 --    'applyVar' v s 'Reanimate.Svg.Constructors.rotate'
+  223 --    'Reanimate.Scene.tweenVar' v 2 $ \\val -> 'Reanimate.fromToS' val 90
+  224 -- @
+  225 --
+  226 --   <<docs/gifs/doc_applyVar.gif>>
+  227 applyVar :: Var s a -> Sprite s -> (a -> SVG -> SVG) -> Scene s ()
+  228 applyVar var sprite fn = spriteModify sprite $ do
+  229   varFn <- unVar var
+  230   return $ first $ fn varFn
+  231 
+  232 -- | Destroy a sprite, preventing it from being rendered in the future of the scene.
+  233 --   If 'destroySprite' is invoked multiple times, the earliest time-of-death is used.
+  234 --
+  235 --   Example:
+  236 --
+  237 -- @
+  238 -- do s <- 'newSpriteSVG' $ 'Reanimate.Svg.Constructors.withFillOpacity' 1 $ 'Reanimate.Svg.Constructors.mkCircle' 1
+  239 --    'fork' $ 'wait' 1 \>\> 'destroySprite' s
+  240 --    'play' 'Reanimate.Builtin.Documentation.drawBox'
+  241 -- @
+  242 --
+  243 --   <<docs/gifs/doc_destroySprite.gif>>
+  244 destroySprite :: Sprite s -> Scene s ()
+  245 destroySprite (Sprite _ ref) = do
+  246   now <- queryNow
+  247   liftST $
+  248     modifySTRef ref $ \(ttl, render) ->
+  249       (if ttl < 0 then now else min ttl now, render)
+  250 
+  251 -- | Low-level frame modifier.
+  252 spriteModify :: Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()
+  253 spriteModify (Sprite born ref) modFn = liftST $
+  254   modifySTRef ref $ \(ttl, renderGen) ->
+  255     ( ttl,
+  256       do
+  257         render <- renderGen
+  258         modRender <- unFrame modFn
+  259         return $ \relD relT ->
+  260           let absT = relT + born in modRender absT relD relT . render relD relT
+  261     )
+  262 
+  263 -- | Map the SVG output of a sprite.
+  264 --
+  265 --   Example:
+  266 --
+  267 -- @
+  268 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle'
+  269 --    'wait' 1
+  270 --    'spriteMap' s 'Reanimate.Svg.Constructors.flipYAxis'
+  271 -- @
+  272 --
+  273 --   <<docs/gifs/doc_spriteMap.gif>>
+  274 spriteMap :: Sprite s -> (SVG -> SVG) -> Scene s ()
+  275 spriteMap sprite@(Sprite born _) fn = do
+  276   now <- queryNow
+  277   let tDelta = now - born
+  278   spriteModify sprite $ do
+  279     t <- spriteT
+  280     return $ \(svg, zindex) -> (if (t - tDelta) < 0 then svg else fn svg, zindex)
+  281 
+  282 -- | Modify the output of a sprite between @now@ and @now+duration@.
+  283 --
+  284 --   Example:
+  285 --
+  286 -- @
+  287 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle'
+  288 --    'spriteTween' s 1 $ \\val -> 'Reanimate.Svg.Constructors.translate' ('Reanimate.Constants.screenWidth'*0.3*val) 0
+  289 -- @
+  290 --
+  291 --   <<docs/gifs/doc_spriteTween.gif>>
+  292 spriteTween :: Sprite s -> Duration -> (Double -> SVG -> SVG) -> Scene s ()
+  293 spriteTween sprite@(Sprite born _) dur fn = do
+  294   now <- queryNow
+  295   let tDelta = now - born
+  296   spriteModify sprite $ do
+  297     t <- spriteT
+  298     return $ first $ \svg -> fn (clamp 0 1 $ (t - tDelta) / dur) svg
+  299   wait dur
+  300   where
+  301     clamp a b v
+  302       | v < a = a
+  303       | v > b = b
+  304       | otherwise = v
+  305 
+  306 -- | Create a new variable and apply it to a sprite.
+  307 --
+  308 --   Example:
+  309 --
+  310 -- @
+  311 -- do s \<- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawBox'
+  312 --    v \<- 'spriteVar' s 0 'Reanimate.Svg.Constructors.rotate'
+  313 --    'Reanimate.Scene.tweenVar' v 2 $ \\val -> 'Reanimate.fromToS' val 90
+  314 -- @
+  315 --
+  316 --   <<docs/gifs/doc_spriteVar.gif>>
+  317 spriteVar :: Sprite s -> a -> (a -> SVG -> SVG) -> Scene s (Var s a)
+  318 spriteVar sprite def fn = do
+  319   v <- newVar def
+  320   applyVar v sprite fn
+  321   return v
+  322 
+  323 -- | Apply an effect to a sprite.
+  324 --
+  325 --   Example:
+  326 --
+  327 -- @
+  328 -- do s <- 'fork' $ 'newSpriteA' 'Reanimate.Builtin.Documentation.drawCircle'
+  329 --    'spriteE' s $ 'Reanimate.Effect.overBeginning' 1 'Reanimate.Effect.fadeInE'
+  330 --    'spriteE' s $ 'Reanimate.Effect.overEnding' 0.5 'Reanimate.Effect.fadeOutE'
+  331 -- @
+  332 --
+  333 --   <<docs/gifs/doc_spriteE.gif>>
+  334 spriteE :: Sprite s -> Effect -> Scene s ()
+  335 spriteE (Sprite born ref) effect = do
+  336   now <- queryNow
+  337   liftST $
+  338     modifySTRef ref $ \(ttl, renderGen) ->
+  339       ( ttl,
+  340         do
+  341           render <- renderGen
+  342           return $ \d t svg ->
+  343             let (svg', z) = render d t svg
+  344              in (delayE (max 0 $ now - born) effect d t svg', z)
+  345       )
+  346 
+  347 -- | Set new ZIndex of a sprite.
+  348 --
+  349 --   Example:
+  350 --
+  351 -- @
+  352 -- do s1 \<- 'newSpriteSVG' $ 'Reanimate.Svg.Constructors.withFillOpacity' 1 $ 'Reanimate.Svg.Constructors.withFillColor' "blue" $ 'Reanimate.Svg.Constructors.mkCircle' 3
+  353 --    'newSpriteSVG' $ 'Reanimate.Svg.Constructors.withFillOpacity' 1 $ 'Reanimate.Svg.Constructors.withFillColor' "red" $ 'Reanimate.Svg.Constructors.mkRect' 8 3
+  354 --    'wait' 1
+  355 --    'spriteZ' s1 1
+  356 --    'wait' 1
+  357 -- @
+  358 --
+  359 --   <<docs/gifs/doc_spriteZ.gif>>
+  360 spriteZ :: Sprite s -> ZIndex -> Scene s ()
+  361 spriteZ (Sprite born ref) zindex = do
+  362   now <- queryNow
+  363   liftST $
+  364     modifySTRef ref $ \(ttl, renderGen) ->
+  365       ( ttl,
+  366         do
+  367           render <- renderGen
+  368           return $ \d t svg ->
+  369             let (svg', z) = render d t svg in (svg', if t < now - born then z else zindex)
+  370       )
+  371 
+  372 -- | Destroy all local sprites at the end of a scene.
+  373 --
+  374 --   Example:
+  375 --
+  376 -- @
+  377 -- do -- the rect lives through the entire 3s animation
+  378 --    'newSpriteSVG_' $ 'Reanimate.Svg.Constructors.translate' (-3) 0 $ 'Reanimate.Svg.Constructors.mkRect' 4 4
+  379 --    'wait' 1
+  380 --    'spriteScope' $ do
+  381 --      -- the circle only lives for 1 second.
+  382 --      local \<- 'newSpriteSVG' $ 'Reanimate.Svg.Constructors.translate' 3 0 $ 'Reanimate.Svg.Constructors.mkCircle' 2
+  383 --      'spriteE' local $ 'Reanimate.Effect.overBeginning' 0.3 'Reanimate.Effect.fadeInE'
+  384 --      'spriteE' local $ 'Reanimate.Effect.overEnding' 0.3 'Reanimate.Effect.fadeOutE'
+  385 --      'wait' 1
+  386 --    'wait' 1
+  387 -- @
+  388 --
+  389 --   <<docs/gifs/doc_spriteScope.gif>>
+  390 spriteScope :: Scene s a -> Scene s a
+  391 spriteScope (M action) = M $ \t -> do
+  392   (a, s, p, gens) <- action t
+  393   return (a, s, p, map (genFn (t + max s p)) gens)
+  394   where
+  395     genFn maxT gen = do
+  396       frameGen <- gen
+  397       return $ \_ t ->
+  398         if t < maxT
+  399           then frameGen maxT t
+  400           else (None, 0)
+  401 
+  402 asAnimation :: (forall s'. Scene s' a) -> Scene s Animation
+  403 asAnimation s = do
+  404   now <- queryNow
+  405   return $ dropA now (scene (wait now >> s))
+  406 
+  407 -- | Apply a transformation with a given overlap. This makes sure
+  408 --   to keep timestamps intact such that events can still be timed
+  409 --   by transcripts.
+  410 transitionO :: Transition -> Double -> (forall s'. Scene s' a) -> (forall s'. Scene s' b) -> Scene s ()
+  411 transitionO t o a b = do
+  412   aA <- asAnimation a
+  413   bA <- fork $ do
+  414     wait (duration aA - o)
+  415     asAnimation b
+  416   play $ overlapT o t aA bA
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Scene.Var.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Scene.Var.hs.html new file mode 100644 index 0000000..9c9d99b --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Scene.Var.hs.html @@ -0,0 +1,192 @@ + + + + + + +
+never executed always true always false
+
+
+    1 {-# LANGUAGE LambdaCase #-}
+    2 {-# LANGUAGE RecordWildCards #-}
+    3 
+    4 module Reanimate.Scene.Var where
+    5 
+    6 import Control.Monad.ST (ST)
+    7 import qualified Data.Map as M
+    8 import Data.STRef
+    9 import Reanimate.Animation (Duration, Time)
+   10 import Reanimate.Scene.Core (Scene, liftST, queryNow, wait)
+   11 
+   12 -- | Time dependent variable.
+   13 newtype Var s a = Var (STRef s (VarData a))
+   14 
+   15 -- Note: We must ensure that upon transforming an VarData,
+   16 --       1. evarDefault old == evarDefault new
+   17 --       2. isNothing (evarLastTime old) || isJust (evarLastTime new) i.e. once evarLastValue has a Just value,
+   18 --          it shouldn't be Nothing again.
+   19 --       3. isNothing (evarLastTime var) => M.null (evarTimeline var)
+   20 data VarData a = VarData
+   21   { evarDefault :: a,
+   22     evarTimeline :: Timeline a,
+   23     evarLastTime :: Maybe Time,
+   24     evarLastValue :: a
+   25   }
+   26 
+   27 data Modifier a = StaticValue a | TweenValue Duration (a -> Time -> a)
+   28 
+   29 type Timeline a = M.Map Time (Modifier a)
+   30 
+   31 -- | Create a new variable with a default value.
+   32 --   Variables always have a defined value even if they are read at a timestamp that is
+   33 --   earlier than when the variable was created. For example:
+   34 --
+   35 -- @
+   36 -- do v \<- 'Reanimate.Scene.fork' ('wait' 10 \>\> 'newVar' 0) -- Create a variable at timestamp '10'.
+   37 --    'readVar' v                       -- Read the variable at timestamp '0'.
+   38 --                                    -- The value of the variable will be '0'.
+   39 -- @
+   40 newVar :: a -> Scene s (Var s a)
+   41 newVar def = Var <$> liftST (newSTRef $ VarData def M.empty Nothing def)
+   42 
+   43 -- | Read the value of a variable at the current timestamp.
+   44 readVar :: Var s a -> Scene s a
+   45 readVar (Var ref) = readVarData <$> liftST (readSTRef ref) <*> queryNow
+   46 
+   47 unpackVar :: Var s a -> ST s (Time -> a)
+   48 unpackVar (Var ref) = readVarData <$> readSTRef ref
+   49 
+   50 -- | Write the value of a variable at the current timestamp.
+   51 --
+   52 --   Example:
+   53 --
+   54 -- @
+   55 -- do v \<- 'newVar' 0
+   56 --    'Reanimate.Scene.newSprite' $ 'Reanimate.Svg.Constructors.mkCircle' \<$\> 'Reanimate.Scene.unVar' v
+   57 --    'writeVar' v 1; 'wait' 1
+   58 --    'writeVar' v 2; 'wait' 1
+   59 --    'writeVar' v 3; 'wait' 1
+   60 -- @
+   61 --
+   62 --   <<docs/gifs/doc_writeVar.gif>>
+   63 writeVar :: Var s a -> a -> Scene s ()
+   64 writeVar (Var ref) val = do
+   65   now <- queryNow
+   66   liftST $ modifySTRef ref $ writeVarData now val
+   67 
+   68 -- | Modify the value of a variable at the current timestamp and all future timestamps.
+   69 modifyVar :: Var s a -> (a -> a) -> Scene s ()
+   70 modifyVar (Var ref) fn = do
+   71   now <- queryNow
+   72   liftST $ modifySTRef ref $ modifyVarData now fn
+   73 
+   74 -- | Modify a variable between @now@ and @now+duration@.
+   75 tweenVar :: Var s a -> Duration -> (a -> Time -> a) -> Scene s ()
+   76 tweenVar _ dur _ | dur < 0 = error "Reanimate.tweenVar: durations must be non-negative"
+   77 tweenVar (Var ref) dur fn = do
+   78   now <- queryNow
+   79   liftST $ modifySTRef ref $ tweenVarData now dur fn
+   80   wait dur
+   81 
+   82 readVarData :: VarData a -> Time -> a
+   83 readVarData (VarData def _ Nothing _) _ = def
+   84 readVarData (VarData def timeline (Just lastTime) lastValue) now
+   85   | now < lastTime = lookupTimeline timeline def now
+   86   | otherwise = lastValue
+   87 
+   88 lookupTimeline :: Timeline a -> a -> Time -> a
+   89 lookupTimeline timeline def now = case M.lookupLE now timeline of
+   90   Just (_, StaticValue sVal) -> sVal
+   91   Just (t, TweenValue dur f)
+   92     | t + dur > now -> f def now
+   93   _ -> def
+   94 
+   95 writeVarData :: Time -> a -> VarData a -> VarData a
+   96 writeVarData now x var =
+   97   let before = keepBefore now var
+   98       after = VarData (evarDefault var) M.empty (Just now) x
+   99    in after `elseVar` before
+  100 
+  101 modifyVarData :: Time -> (a -> a) -> VarData a -> VarData a
+  102 modifyVarData now fn var =
+  103   let before = keepBefore now var
+  104       after = keepFrom now var
+  105       timeline = flip M.map (evarTimeline after) $ \case
+  106         StaticValue s -> StaticValue $ fn s
+  107         TweenValue dur f -> TweenValue dur $ \a t -> fn (f a t)
+  108    in after {evarTimeline = timeline, evarLastValue = fn $ evarLastValue after} `elseVar` before
+  109 
+  110 -- Note: The function passed here takes time on the scale 0 to 1
+  111 --       while the function in `TweenValue` takes time on an absolute scale.
+  112 tweenVarData :: Time -> Duration -> (a -> Time -> a) -> VarData a -> VarData a
+  113 tweenVarData st dur fn var@VarData {..} =
+  114   let nd = st + dur
+  115       before = keepBefore st var
+  116       during = keepInRange (Just st) (Just nd) var
+  117       tweenFn a t =
+  118         let idx = (t - st) / dur
+  119             idx' = if isNaN idx then 1 else idx
+  120          in fn (readVarData (during {evarDefault = a}) t) idx'
+  121       valueTweenEnd = tweenFn evarDefault nd -- we'll never use the def here, replace with error?
+  122       after = VarData evarDefault (M.singleton st $ TweenValue dur tweenFn) (Just nd) valueTweenEnd
+  123    in after `elseVar` before
+  124 
+  125 -- Returns the union of two vars such that we use the second var if first var doesn't have a value.
+  126 -- Assumes both vars have same default value.
+  127 elseVar :: VarData a -> VarData a -> VarData a
+  128 elseVar var1 var2
+  129   | Just t <- evarLastTime var1 =
+  130     let afterTimeline = evarTimeline var1
+  131         joinAt = maybe t fst $ M.lookupMin afterTimeline
+  132         beforeTimeline = case keepBefore joinAt var2 of
+  133           x
+  134             | Just lastTime <- evarLastTime x, lastTime < joinAt -> M.insert lastTime (StaticValue $ evarLastValue x) $ evarTimeline x
+  135             | otherwise -> evarTimeline x
+  136      in var1 {evarTimeline = M.union afterTimeline beforeTimeline}
+  137   | otherwise = var2
+  138 
+  139 -- Restrict a var to a given time interval.
+  140 keepInRange :: Maybe Time -> Maybe Time -> VarData a -> VarData a
+  141 keepInRange st nd = maybe id keepFrom st . maybe id keepBefore nd
+  142 
+  143 -- Restrict a var to start at given timestamp.
+  144 keepFrom :: Time -> VarData a -> VarData a
+  145 keepFrom st VarData {..} =
+  146   let timeline' = M.dropWhileAntitone (< st) evarTimeline
+  147       -- if there is no modifier in timeline starting at st,
+  148       -- we must get the modifier that starts before and truncate it to start at st.
+  149       timeline'' = case M.lookupLE st evarTimeline of
+  150         Just (t, val@(StaticValue _))
+  151           | t < st -> M.insert st val timeline'
+  152         Just (t, TweenValue dur fn)
+  153           | t < st, t + dur > st -> M.insert st (TweenValue (t + dur - st) fn) timeline'
+  154         _ -> timeline'
+  155    in VarData evarDefault timeline'' (max evarLastTime $ Just st) evarLastValue
+  156 
+  157 -- Restrict a var to end(clamp) at given timestamp.
+  158 keepBefore :: Time -> VarData a -> VarData a
+  159 keepBefore nd var@VarData {..} =
+  160   let timeline' = M.takeWhileAntitone (< nd) evarTimeline
+  161       lastModifier = M.lookupMax timeline'
+  162       timeline'' = case lastModifier of
+  163         Just (t, TweenValue dur fn)
+  164           | t + dur > nd -> M.insert t (TweenValue (nd - t) fn) timeline'
+  165         _ -> timeline'
+  166       lastTime = case lastModifier of
+  167         Just (t, TweenValue dur _) -> Just $ min nd (t + dur)
+  168         _ -> min nd <$> evarLastTime
+  169    in VarData evarDefault timeline'' lastTime (maybe evarDefault (readVarData var) lastTime)
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Svg.BoundingBox.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Svg.BoundingBox.hs.html new file mode 100644 index 0000000..314bcde --- /dev/null +++ b/reanimate-1.0.0.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
+   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 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-1.0.0.0-inplace/Reanimate.Svg.Constructors.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Svg.Constructors.hs.html new file mode 100644 index 0000000..d612b53 --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Svg.Constructors.hs.html @@ -0,0 +1,449 @@ + + + + + + +
+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
+   66 import           Graphics.SvgTree.NamedColors
+   67 import           Graphics.SvgTree.PathParser
+   68 import           Linear.V2                    hiding (angle)
+   69 import           Reanimate.Constants
+   70 import           Reanimate.Svg.BoundingBox
+   71 
+   72 -- | Apply list of transformations to given image.
+   73 withTransformations :: [Transformation] -> Tree -> Tree
+   74 withTransformations transformations t =
+   75   mkGroup [t] & transform ?~ transformations
+   76 
+   77 -- | @translate x y image@ moves the @image@ by @x@ along X-axis and by @y@ along Y-axis.
+   78 translate :: Double -> Double -> Tree -> Tree
+   79 translate x y = withTransformations [Translate x y]
+   80 
+   81 -- | @rotate angle image@ rotates the @image@ around origin @(0,0)@ counterclockwise by @angle@
+   82 --   given in degrees.
+   83 rotate :: Double -> Tree -> Tree
+   84 rotate a = withTransformations [Rotate a Nothing]
+   85 
+   86 -- | @rotate angle point image@ rotates the @image@ around given @point@ counterclockwise by
+   87 --   @angle@ given in degrees.
+   88 rotateAround :: Double -> RPoint -> Tree -> Tree
+   89 rotateAround a (V2 x y) = withTransformations [Rotate a (Just (x,y))]
+   90 
+   91 -- | @rotate angle image@ rotates the @image@ around the center of its bounding box counterclockwise
+   92 --   by @angle@ given in degrees.
+   93 rotateAroundCenter :: Double -> Tree -> Tree
+   94 rotateAroundCenter a t =
+   95     rotateAround a (V2 (x+w/2) (y+h/2)) t
+   96   where
+   97     (x,y,w,h) = boundingBox t
+   98 
+   99 -- | @aroundCenter f image@ first moves the image so the center of its bounding box is at the origin
+  100 --   @(0, 0)@, applies transformation @f@ to it and then moves the transformed image back to its
+  101 --   original position.
+  102 aroundCenter :: (Tree -> Tree) -> Tree -> Tree
+  103 aroundCenter fn t =
+  104     translate (-offsetX) (-offsetY) $ fn $ translate offsetX offsetY t
+  105   where
+  106     offsetX = -x-w/2
+  107     offsetY = -y-h/2
+  108     (x,y,w,h) = boundingBox t
+  109 
+  110 -- | Same as 'aroundCenter' but only for the Y-axis.
+  111 aroundCenterY :: (Tree -> Tree) -> Tree -> Tree
+  112 aroundCenterY fn t =
+  113     translate 0 (-offsetY) $ fn $ translate 0 offsetY t
+  114   where
+  115     offsetY = -y-h/2
+  116     (_x,y,_w,h) = boundingBox t
+  117 
+  118 -- | Same as 'aroundCenter' but only for the X-axis.
+  119 aroundCenterX :: (Tree -> Tree) -> Tree -> Tree
+  120 aroundCenterX fn t =
+  121     translate (-offsetX) 0 $ fn $ translate offsetX 0 t
+  122   where
+  123     offsetX = -x-w/2
+  124     (x,_y,w,_h) = boundingBox t
+  125 
+  126 -- | Scale the image uniformly by given factor along both X and Y axes.
+  127 -- For example @scale 2 image@  makes the image twice as large, while @scale 0.5 image@ makes it
+  128 -- half the original size. Negative values are also allowed, and lead to flipping the image along
+  129 -- both X and Y axes.
+  130 scale :: Double -> Tree -> Tree
+  131 scale a = withTransformations [Scale a Nothing]
+  132 
+  133 -- | @scaleToSize width height@ resizes the image so that its bounding box has corresponding @width@
+  134 --   and @height@.
+  135 scaleToSize :: Double -> Double -> Tree -> Tree
+  136 scaleToSize w h t =
+  137     scaleXY (w/w') (h/h') t
+  138   where
+  139     (_x, _y, w', h') = boundingBox t
+  140 
+  141 -- | @scaleToWidth width@ scales the image so that the width of its bounding box ends up having
+  142 --   given @width@.
+  143 scaleToWidth :: Double -> Tree -> Tree
+  144 scaleToWidth w t =
+  145     scale (w/w') t
+  146   where
+  147     (_x, _y, w', _h') = boundingBox t
+  148 
+  149 -- | @scaleToHeight height@ scales the image so that the height of its bounding box ends up having
+  150 --   given @height@.
+  151 scaleToHeight :: Double -> Tree -> Tree
+  152 scaleToHeight h t =
+  153     scale (h/h') t
+  154   where
+  155     (_x, _y, _w', h') = boundingBox t
+  156 
+  157 -- | Similar to 'scale', except scale factors for X and Y axes are specified separately.
+  158 scaleXY :: Double -> Double -> Tree -> Tree
+  159 scaleXY x y = withTransformations [Scale x (Just y)]
+  160 
+  161 
+  162 -- | Flip the image along vertical axis so that what was on the right will end up on left and vice
+  163 --   versa.
+  164 flipXAxis :: Tree -> Tree
+  165 flipXAxis = scaleXY (-1) 1
+  166 
+  167 -- | Flip the image along horizontal so that what was on the top will end up in the bottom and vice
+  168 --   versa.
+  169 flipYAxis :: Tree -> Tree
+  170 flipYAxis = scaleXY 1 (-1)
+  171 
+  172 -- | Translate given image so that the center of its bouding box coincides with coordinates
+  173 --   @(0, 0)@.
+  174 center :: Tree -> Tree
+  175 center t = centerUsing t t
+  176 
+  177 -- | Translate given image so that the X-coordinate of the center of its bouding box is 0.
+  178 centerX :: Tree -> Tree
+  179 centerX t = translate (-x-w/2) 0 t
+  180   where
+  181     (x, _y, w, _h) = boundingBox t
+  182 
+  183 -- | Translate given image so that the Y-coordinate of the center of its bouding box is 0.
+  184 centerY :: Tree -> Tree
+  185 centerY t = translate 0 (-y-h/2) t
+  186   where
+  187     (_x, y, _w, h) = boundingBox t
+  188 
+  189 -- | Center the second argument using the bounding-box of the first.
+  190 centerUsing :: Tree -> Tree -> Tree
+  191 centerUsing a = translate (-x-w/2) (-y-h/2)
+  192   where
+  193     (x, y, w, h) = boundingBox a
+  194 
+  195 -- | Create 'Texture' based on SVG color name.
+  196 --   See <https://en.wikipedia.org/wiki/Web_colors#X11_color_names> for the list of available names.
+  197 --   If the provided name doesn't correspond to valid SVG color name, white-ish color is used.
+  198 mkColor :: String -> Texture
+  199 mkColor name =
+  200   case Map.lookup (T.pack name) svgNamedColors of
+  201     Nothing -> ColorRef (PixelRGBA8 240 248 255 255)
+  202     Just c  -> ColorRef c
+  203 
+  204 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>
+  205 withStrokeColor :: String -> Tree -> Tree
+  206 withStrokeColor color = strokeColor .~ pure (mkColor color)
+  207 
+  208 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>
+  209 withStrokeColorPixel :: PixelRGBA8 -> Tree -> Tree
+  210 withStrokeColorPixel color = strokeColor .~ pure (ColorRef color)
+  211 
+  212 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-dasharray>
+  213 withStrokeDashArray :: [Double] -> Tree -> Tree
+  214 withStrokeDashArray arr = strokeDashArray .~ pure (map Num arr)
+  215 
+  216 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-linejoin>
+  217 withStrokeLineJoin :: LineJoin -> Tree -> Tree
+  218 withStrokeLineJoin ljoin = strokeLineJoin .~ pure ljoin
+  219 
+  220 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>
+  221 withFillColor :: String -> Tree -> Tree
+  222 withFillColor color = fillColor .~ pure (mkColor color)
+  223 
+  224 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>
+  225 withFillColorPixel :: PixelRGBA8 -> Tree -> Tree
+  226 withFillColorPixel color = fillColor .~ pure (ColorRef color)
+  227 
+  228 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill-opacity>
+  229 withFillOpacity :: Double -> Tree -> Tree
+  230 withFillOpacity opacity = fillOpacity ?~ realToFrac opacity
+  231 
+  232 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/opacity>
+  233 withGroupOpacity :: Double -> Tree -> Tree
+  234 withGroupOpacity opacity = groupOpacity ?~ realToFrac opacity
+  235 
+  236 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-width>
+  237 withStrokeWidth :: Double -> Tree -> Tree
+  238 withStrokeWidth width = strokeWidth .~ pure (Num width)
+  239 
+  240 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/clip-path>
+  241 withClipPathRef :: ElementRef -- ^ Reference to clip path defined previously (e.g. by 'mkClipPath')
+  242                 -> Tree -- ^ Image that will be clipped by the referenced clip path
+  243                 -> Tree
+  244 withClipPathRef ref sub = mkGroup [sub] & clipPathRef .~ pure ref
+  245 
+  246 -- | Assigns ID attribute to given image.
+  247 withId :: String -> Tree -> Tree
+  248 withId idTag = attrId ?~ idTag
+  249 
+  250 -- | @mkRect width height@ creates a rectangle with given @with@ and @height@, centered at @(0, 0)@.
+  251 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/rect>
+  252 mkRect :: Double -> Double -> Tree
+  253 mkRect width height = translate (-width/2) (-height/2) $ rectangleTree $ defaultSvg
+  254   & rectUpperLeftCorner .~ (Num 0, Num 0)
+  255   & rectWidth ?~ Num width
+  256   & rectHeight ?~ Num height
+  257 
+  258 -- | Create a circle with given radius, centered at @(0, 0)@.
+  259 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/circle>
+  260 mkCircle :: Double -> Tree
+  261 mkCircle radius = circleTree $ defaultSvg
+  262   & circleCenter .~ (Num 0, Num 0)
+  263   & circleRadius .~ Num radius
+  264 
+  265 -- | Create an ellipse given X-axis radius, and Y-axis radius, with center at @(0, 0)@.
+  266 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/ellipse>
+  267 mkEllipse :: Double -> Double -> Tree
+  268 mkEllipse rx ry = ellipseTree $ defaultSvg
+  269   & ellipseCenter .~ (Num 0, Num 0)
+  270   & ellipseXRadius .~ Num rx
+  271   & ellipseYRadius .~ Num ry
+  272 
+  273 -- | Create a line segment between two points given by their @(x, y)@ coordinates.
+  274 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/line>
+  275 mkLine :: (Double,Double) -> (Double, Double) -> Tree
+  276 mkLine (x1,y1) (x2,y2) = lineTree $ defaultSvg
+  277   & linePoint1 .~ (Num x1, Num y1)
+  278   & linePoint2 .~ (Num x2, Num y2)
+  279 
+  280 -- | Merges multiple images into one.
+  281 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/g>
+  282 mkGroup :: [Tree] -> Tree
+  283 mkGroup forest = groupTree $ defaultSvg
+  284   & groupChildren .~ forest
+  285 
+  286 -- | Create definition of graphical objects that can be used at later time.
+  287 --   See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/defs>
+  288 mkDefinitions :: [Tree] -> Tree
+  289 mkDefinitions forest = definitionTree $ defaultSvg
+  290   & groupChildren .~ forest
+  291 
+  292 -- | Create an element by referring to existing element defined previously.
+  293 -- For example you can create a graphical element, assign ID to it using 'withId', wrap it in
+  294 -- 'mkDefinitions' and then use it via @use "myId"@.
+  295 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/use>
+  296 mkUse :: String -> Tree
+  297 mkUse name = useTree (defaultSvg & useName .~ name)
+  298 
+  299 -- | A clip path restricts the region to which paint can be applied.
+  300 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/clipPath>
+  301 mkClipPath :: String  -- ^ ID of the clip path, which can then be referred to by other elements
+  302                       --   using 'withClipPathRef'.
+  303            -> [Tree] -- ^ List of shapes that will determine the final shape of the clipping region
+  304            -> Tree
+  305 mkClipPath idTag forest = withId idTag $ clipPathTree $ defaultSvg
+  306   & clipPathContent .~ forest
+  307 
+  308 -- | Create a path from the list of path commands.
+  309 --   See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d#Path_commands>
+  310 mkPath :: [PathCommand] -> Tree
+  311 mkPath cmds = pathTree $ defaultSvg & pathDefinition .~ cmds
+  312 
+  313 -- | Similar to 'mkPathText', but taking SVG path command as a String.
+  314 mkPathString :: String -> Tree
+  315 mkPathString = mkPathText . T.pack
+  316 
+  317 -- | Create path from textual representation of SVG path command.
+  318 --   If the text doesn't represent valid path command, this function fails with 'Prelude.error'.
+  319 --   Use 'mkPath' for type safe way of creating paths.
+  320 mkPathText :: T.Text -> Tree
+  321 mkPathText str =
+  322   case parseOnly pathParser str of
+  323     Left err   -> error err
+  324     Right cmds -> mkPath cmds
+  325 
+  326 -- | Create a path from a list of @(x, y)@ coordinates of points along the path.
+  327 mkLinePath :: [(Double, Double)] -> Tree
+  328 mkLinePath [] = mkGroup []
+  329 mkLinePath ((startX, startY):rest) =
+  330     pathTree $ defaultSvg & pathDefinition .~ cmds
+  331   where
+  332     cmds = [ MoveTo OriginAbsolute [V2 startX startY]
+  333            , LineTo OriginAbsolute [ V2 x y | (x, y) <- rest ] ]
+  334 
+  335 -- | Create a path from a list of @(x, y)@ coordinates of points along the path.
+  336 mkLinePathClosed :: [(Double, Double)] -> Tree
+  337 mkLinePathClosed [] = mkGroup []
+  338 mkLinePathClosed ((startX, startY):rest) =
+  339     pathTree $ defaultSvg & pathDefinition .~ cmds
+  340   where
+  341     cmds = [ MoveTo OriginAbsolute [V2 startX startY]
+  342            , LineTo OriginAbsolute [ V2 x y | (x, y) <- rest ]
+  343            , EndPath ]
+  344 
+  345 -- | Rectangle with a uniform color and the same size as the screen.
+  346 --
+  347 --   Example:
+  348 --
+  349 -- @
+  350 -- 'Reanimate.animate' $ 'const' $ 'mkBackground' "yellow"
+  351 -- @
+  352 --
+  353 --   <<docs/gifs/doc_mkBackground.gif>>
+  354 mkBackground :: String -> Tree
+  355 mkBackground color = withFillOpacity 1 $  withStrokeWidth 0 $
+  356   withFillColor color $ mkRect screenWidth screenHeight
+  357 
+  358 -- | Rectangle with a uniform color and the same size as the screen.
+  359 mkBackgroundPixel :: PixelRGBA8 -> Tree
+  360 mkBackgroundPixel pixel =
+  361     withFillOpacity 1 $ withStrokeWidth 0 $
+  362     withFillColorPixel pixel $ mkRect screenWidth screenHeight
+  363 
+  364 -- | Take list of rows, where each row consists of number of images and display them in regular
+  365 --   grid structure.
+  366 --   All rows will get equal amount of vertical space.
+  367 --   The images within each row will get equal amount of horizontal space, independent of the other
+  368 --   rows. Each row can contain different number of cells.
+  369 gridLayout :: [[Tree]] -> Tree
+  370 gridLayout rows = mkGroup
+  371     [ translate (-screenWidth/2+colSep*nCol + colSep*0.5)
+  372                 (screenHeight/2-rowSep*nRow - rowSep*0.5)
+  373       elt
+  374     | (nRow, row) <- zip [0..] rows
+  375     , let nCols = length row
+  376           colSep = screenWidth / fromIntegral nCols
+  377     , (nCol, elt) <- zip [0..] row ]
+  378   where
+  379     rowSep = screenHeight / fromIntegral nRows
+  380     nRows = length rows
+  381 
+  382 -- | Insert a native text object anchored at the middle.
+  383 --
+  384 --   Example:
+  385 --
+  386 -- @
+  387 -- 'Reanimate.mkAnimation' 2 $ \\t -> 'scale' 2 $ 'withStrokeWidth' 0.05 $ 'mkText' (T.take (round $ t*15) "text")
+  388 -- @
+  389 --
+  390 --   <<docs/gifs/doc_mkText.gif>>
+  391 mkText :: T.Text -> Tree
+  392 mkText str =
+  393   flipYAxis
+  394   (TextTree Nothing $ defaultSvg
+  395     & textRoot .~ span_
+  396     & fontSize .~ pure (Num 2))
+  397     & textAnchor .~ pure TextAnchorMiddle
+  398     -- Note: TextAnchorMiddle is placed on the 'flipYAxis' group such that it can easily
+  399     -- be overwritten by the user.
+  400   where
+  401     span_ = defaultSvg & spanContent .~ [SpanText str]
+  402 
+  403 -- | Switch from the default viewbox to a custom viewbox. Nesting custom viewboxes is
+  404 --   unlikely to give good results. If you need nested custom viewboxes, you will have
+  405 --   to configure them by hand.
+  406 --
+  407 --   The viewbox argument is (min-x, min-y, width, height).
+  408 --
+  409 --   Example:
+  410 --
+  411 -- @
+  412 -- 'withViewBox' (0,0,1,1) $ 'mkBackground' "yellow"
+  413 -- @
+  414 --
+  415 --   <<docs/gifs/doc_withViewBox.gif>>
+  416 withViewBox :: (Double, Double, Double, Double) -> Tree -> Tree
+  417 withViewBox vbox child = translate (-screenWidth/2) (-screenHeight/2) $
+  418   svgTree Document
+  419   { _documentViewBox = Just vbox
+  420   , _documentWidth = Just (Num screenWidth)
+  421   , _documentHeight = Just (Num screenHeight)
+  422   , _documentElements = [child]
+  423   , _documentDescription = ""
+  424   , _documentLocation = ""
+  425   , _documentAspectRatio = PreserveAspectRatio False AlignNone Nothing
+  426   }
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Svg.LineCommand.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Svg.LineCommand.hs.html new file mode 100644 index 0000000..1001d49 --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Svg.LineCommand.hs.html @@ -0,0 +1,315 @@ + + + + + + +
+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 module Reanimate.Svg.LineCommand
+    8   ( CmdM,
+    9     LineCommand (..),
+   10     lineLength,
+   11     toLineCommands,
+   12     lineToPath,
+   13     lineToPoints,
+   14     partialSvg,
+   15   )
+   16 where
+   17 
+   18 import Control.Lens ((%~), (&), (.~))
+   19 import Control.Monad.Fix
+   20 import Control.Monad.State
+   21 import Data.Functor
+   22 import Data.Maybe
+   23 import qualified Data.Vector.Unboxed as V
+   24 import qualified Geom2D.CubicBezier.Linear as Bezier
+   25 import Graphics.SvgTree
+   26 import Linear.Metric
+   27 import Linear.V2 hiding (angle)
+   28 import Linear.Vector
+   29 
+   30 -- | Line command monad used for keeping track of the current location.
+   31 type CmdM a = State RPoint a
+   32 
+   33 -- | Simplified version of a PathCommand where all points are absolute.
+   34 data LineCommand
+   35   = LineMove RPoint
+   36   | -- | LineDraw RPoint
+   37     LineBezier [RPoint]
+   38   | LineEnd RPoint
+   39   deriving (Show)
+   40 
+   41 -- | Convert from line commands to path commands.
+   42 lineToPath :: [LineCommand] -> [PathCommand]
+   43 lineToPath = map worker
+   44   where
+   45     worker (LineMove p) = MoveTo OriginAbsolute [p]
+   46     -- worker (LineDraw p)         = LineTo OriginAbsolute [p]
+   47     worker (LineBezier [a, b, c]) = CurveTo OriginAbsolute [(a, b, c)]
+   48     worker (LineBezier [a, b]) = QuadraticBezier OriginAbsolute [(a, b)]
+   49     worker (LineBezier [a]) = LineTo OriginAbsolute [a]
+   50     worker LineBezier {} = error "Reanimate.Svg.lineToPath: invalid bezier curve"
+   51     worker LineEnd {} = EndPath
+   52 
+   53 -- | Using @n@ control points, approximate the path of the curves.
+   54 lineToPoints :: Int -> [LineCommand] -> [RPoint]
+   55 lineToPoints nPoints cmds =
+   56   mapMaybe lineEnd lineSegments
+   57   where
+   58     lineSegments = [partialLine (fromIntegral n / fromIntegral nPoints) cmds | n <- [0 .. nPoints -1]]
+   59     lineEnd [] = Nothing
+   60     lineEnd [LineBezier pts] = Just (last pts)
+   61     lineEnd (_ : xs) = lineEnd xs
+   62 
+   63 partialLine :: Double -> [LineCommand] -> [LineCommand]
+   64 partialLine alpha cmds = evalState (worker 0 cmds) zero
+   65   where
+   66     worker _d [] = pure []
+   67     worker d (cmd : xs) = do
+   68       from <- get
+   69       len <- lineLength cmd
+   70       let frac = (targetLen - d) / len
+   71       if len == 0 || frac >= 1
+   72         then (cmd :) <$> worker (d + len) xs
+   73         else pure [adjustLineLength frac from cmd]
+   74     totalLen = evalState (sum <$> mapM lineLength cmds) zero
+   75     targetLen = totalLen * alpha
+   76 
+   77 adjustLineLength :: Double -> RPoint -> LineCommand -> LineCommand
+   78 adjustLineLength alpha from cmd =
+   79   case cmd of
+   80     LineBezier points -> LineBezier $ drop 1 $ partialBezierPoints (from : points) 0 alpha
+   81     LineMove p -> LineMove p
+   82     -- LineDraw t -> LineDraw (lerp alpha t from)
+   83     LineEnd p -> LineBezier [lerp alpha p from]
+   84 
+   85 -- | Estimated length of all segments in a line.
+   86 lineLength :: LineCommand -> CmdM Double
+   87 lineLength cmd =
+   88   case cmd of
+   89     LineMove to -> 0 <$ put to
+   90     -- Straight line:
+   91     LineBezier [dst] -> gets (distance dst) <* put dst
+   92     -- Some kind of curve:
+   93     LineBezier lst -> do
+   94       from <- get
+   95       let bezier = rpointsToBezier (from : lst)
+   96           tol = 0.0001
+   97       put (last lst)
+   98       pure $ Bezier.arcLength bezier 1 tol
+   99     LineEnd to -> gets (distance to) <* put to
+  100 
+  101 rpointsToBezier :: [RPoint] -> Bezier.CubicBezier Double
+  102 rpointsToBezier lst =
+  103   case lst of
+  104     [a, b] -> Bezier.CubicBezier a a b b
+  105     [a, b, c] -> Bezier.quadToCubic (Bezier.QuadBezier a b c)
+  106     [a, b, c, d] -> Bezier.CubicBezier a b c d
+  107     _ -> error $ "rpointsToBezier: Invalid list of points: " ++ show lst
+  108 
+  109 -- | Convert from path commands to line commands.
+  110 toLineCommands :: [PathCommand] -> [LineCommand]
+  111 toLineCommands ps = evalState (worker zero Nothing ps) zero
+  112   where
+  113     worker _startPos _mbPrevControlPt [] = pure []
+  114     worker startPos mbPrevControlPt (cmd : cmds) = do
+  115       lcmds <- toLineCommand startPos mbPrevControlPt cmd
+  116       let startPos' =
+  117             case lcmds of
+  118               [LineMove pos] -> pos
+  119               _ -> startPos
+  120       (lcmds ++) <$> worker startPos' (cmdToControlPoint $ last lcmds) cmds
+  121 
+  122 cmdToControlPoint :: LineCommand -> Maybe RPoint
+  123 cmdToControlPoint (LineBezier points) = Just (last (init points))
+  124 cmdToControlPoint _ = Nothing
+  125 
+  126 mkStraightLine :: RPoint -> LineCommand
+  127 mkStraightLine p = LineBezier [p]
+  128 
+  129 toLineCommand :: RPoint -> Maybe RPoint -> PathCommand -> CmdM [LineCommand]
+  130 toLineCommand startPos mbPrevControlPt cmd =
+  131   case cmd of
+  132     MoveTo OriginAbsolute [] -> pure []
+  133     MoveTo OriginAbsolute lst -> put (last lst) *> gets (pure . LineMove)
+  134     MoveTo OriginRelative lst -> modify (+ sum lst) *> gets (pure . LineMove)
+  135     LineTo OriginAbsolute lst -> forM lst (\to -> put to $> mkStraightLine to)
+  136     LineTo OriginRelative lst -> forM lst (\to -> modify (+ to) *> gets mkStraightLine)
+  137     HorizontalTo OriginAbsolute lst ->
+  138       forM lst $ \x -> modify (_x .~ x) *> gets mkStraightLine
+  139     HorizontalTo OriginRelative lst ->
+  140       forM lst $ \x -> modify (_x %~ (+ x)) *> gets mkStraightLine
+  141     VerticalTo OriginAbsolute lst ->
+  142       forM lst $ \y -> modify (_y .~ y) *> gets mkStraightLine
+  143     VerticalTo OriginRelative lst ->
+  144       forM lst $ \y -> modify (_y %~ (+ y)) *> gets mkStraightLine
+  145     CurveTo OriginAbsolute quads ->
+  146       forM quads $ \(a, b, c) -> put c $> LineBezier [a, b, c]
+  147     CurveTo OriginRelative quads ->
+  148       forM quads $ \(a, b, c) -> do
+  149         from <- get <* modify (+ c)
+  150         pure $ LineBezier $ map (+ from) [a, b, c]
+  151     SmoothCurveTo o lst -> mfix $ \result -> do
+  152       let ctrl = mbPrevControlPt : map cmdToControlPoint result
+  153       forM (zip lst ctrl) $ \((c2, to), mbControl) -> do
+  154         from <- get <* adjustPosition o to
+  155         let c1 = maybe (makeAbsolute o from c2) (mirrorPoint from) mbControl
+  156         pure $ LineBezier [c1, makeAbsolute o from c2, makeAbsolute o from to]
+  157     QuadraticBezier OriginAbsolute pairs ->
+  158       forM pairs $ \(a, b) -> put b $> LineBezier [a, b]
+  159     QuadraticBezier OriginRelative pairs ->
+  160       forM pairs $ \(a, b) -> do
+  161         from <- get <* modify (+ b)
+  162         pure $ LineBezier $ map (+ from) [a, b]
+  163     SmoothQuadraticBezierCurveTo o lst -> mfix $ \result -> do
+  164       let ctrl = mbPrevControlPt : map cmdToControlPoint result
+  165       forM (zip lst ctrl) $ \(to, mbControl) -> do
+  166         from <- get <* adjustPosition o to
+  167         let c1 = maybe from (mirrorPoint from) mbControl
+  168         pure $ LineBezier [c1, makeAbsolute o from to]
+  169     EllipticalArc o points ->
+  170       concat
+  171         <$> forM
+  172           points
+  173           ( \(rotX, rotY, angle, largeArc, sweepFlag, to) -> do
+  174               from <- get <* adjustPosition o to
+  175               return $ convertSvgArc from rotX rotY angle largeArc sweepFlag (makeAbsolute o from to)
+  176           )
+  177     EndPath -> put startPos $> [LineEnd startPos]
+  178   where
+  179     mirrorPoint c p = c * 2 - p
+  180     adjustPosition OriginRelative p = modify (+ p)
+  181     adjustPosition OriginAbsolute p = put p
+  182     makeAbsolute OriginAbsolute _from p = p
+  183     makeAbsolute OriginRelative from p = from + p
+  184 
+  185 calculateVectorAngle :: Double -> Double -> Double -> Double -> Double
+  186 calculateVectorAngle ux uy vx vy
+  187   | tb >= ta =
+  188     tb - ta
+  189   | otherwise =
+  190     pi * 2 - (ta - tb)
+  191   where
+  192     ta = atan2 uy ux
+  193     tb = atan2 vy vx
+  194 
+  195 -- ported from: https://github.com/vvvv/SVG/blob/master/Source/Paths/SvgArcSegment.cs
+  196 {- HLINT ignore convertSvgArc -}
+  197 convertSvgArc :: RPoint -> Coord -> Coord -> Coord -> Bool -> Bool -> RPoint -> [LineCommand]
+  198 convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)
+  199   | x0 == x && y0 == y =
+  200     []
+  201   | radiusX == 0.0 && radiusY == 0.0 =
+  202     [LineBezier [V2 x y]]
+  203   | otherwise =
+  204     calcSegments x0 y0 theta1' segments'
+  205   where
+  206     sinPhi = sin (angle * pi / 180)
+  207     cosPhi = cos (angle * pi / 180)
+  208 
+  209     x1dash = cosPhi * (x0 - x) / 2.0 + sinPhi * (y0 - y) / 2.0
+  210     y1dash = - sinPhi * (x0 - x) / 2.0 + cosPhi * (y0 - y) / 2.0
+  211 
+  212     numerator = radiusX * radiusX * radiusY * radiusY - radiusX * radiusX * y1dash * y1dash - radiusY * radiusY * x1dash * x1dash
+  213 
+  214     s = sqrt (1.0 - numerator / (radiusX * radiusX * radiusY * radiusY))
+  215     rx = if (numerator < 0.0) then (radiusX * s) else radiusX
+  216     ry = if (numerator < 0.0) then (radiusY * s) else radiusY
+  217     root =
+  218       if (numerator < 0.0)
+  219         then (0.0)
+  220         else
+  221           ( (if ((largeArcFlag && sweepFlag) || (not largeArcFlag && not sweepFlag)) then (-1.0) else 1.0)
+  222               * sqrt (numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash))
+  223           )
+  224 
+  225     cxdash = root * rx * y1dash / ry
+  226     cydash = - root * ry * x1dash / rx
+  227 
+  228     cx = cosPhi * cxdash - sinPhi * cydash + (x0 + x) / 2.0
+  229     cy = sinPhi * cxdash + cosPhi * cydash + (y0 + y) / 2.0
+  230 
+  231     theta1' = calculateVectorAngle 1.0 0.0 ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry)
+  232     dtheta' = calculateVectorAngle ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry) ((- x1dash - cxdash) / rx) ((- y1dash - cydash) / ry)
+  233     dtheta =
+  234       if (not sweepFlag && dtheta' > 0)
+  235         then (dtheta' - 2 * pi)
+  236         else (if (sweepFlag && dtheta' < 0) then dtheta' + 2 * pi else dtheta')
+  237 
+  238     segments' = ceiling (abs (dtheta / (pi / 2.0)))
+  239     delta = dtheta / fromInteger segments'
+  240     t = 8.0 / 3.0 * sin (delta / 4.0) * sin (delta / 4.0) / sin (delta / 2.0)
+  241 
+  242     calcSegments startX startY theta1 segments
+  243       | segments == 0 =
+  244         []
+  245       | otherwise =
+  246         LineBezier
+  247           [ V2 (startX + dx1) (startY + dy1),
+  248             V2 (endpointX + dxe) (endpointY + dye),
+  249             V2 endpointX endpointY
+  250           ] :
+  251         calcSegments endpointX endpointY theta2 (segments - 1)
+  252       where
+  253         cosTheta1 = cos theta1
+  254         sinTheta1 = sin theta1
+  255         theta2 = theta1 + delta
+  256         cosTheta2 = cos theta2
+  257         sinTheta2 = sin theta2
+  258 
+  259         endpointX = cosPhi * rx * cosTheta2 - sinPhi * ry * sinTheta2 + cx
+  260         endpointY = sinPhi * rx * cosTheta2 + cosPhi * ry * sinTheta2 + cy
+  261 
+  262         dx1 = t * (- cosPhi * rx * sinTheta1 - sinPhi * ry * cosTheta1)
+  263         dy1 = t * (- sinPhi * rx * sinTheta1 + cosPhi * ry * cosTheta1)
+  264 
+  265         dxe = t * (cosPhi * rx * sinTheta2 + sinPhi * ry * cosTheta2)
+  266         dye = t * (sinPhi * rx * sinTheta2 - cosPhi * ry * cosTheta2)
+  267 
+  268 partialBezierPoints :: [RPoint] -> Double -> Double -> [RPoint]
+  269 partialBezierPoints ps a b =
+  270   let c1 = Bezier.AnyBezier (V.fromList ps)
+  271       Bezier.AnyBezier os = Bezier.bezierSubsegment c1 a b
+  272    in V.toList os
+  273 
+  274 -- | Create an image showing portion of a path.
+  275 --     Note that this only affects paths (see 'Reanimate.Svg.Constructors.mkPath').
+  276 --     You can also use this with other SVG shapes if you convert them to path first (see 'Reanimate.Svg.pathify').
+  277 --
+  278 --     Typical usage:
+  279 --
+  280 --    > animate $ \t -> partialSvg t myPath
+  281 partialSvg ::
+  282   -- | number between 0 and 1 inclusively, determining what portion of the path to show
+  283   Double ->
+  284   -- | Image representing a path, of which we only want to display a portion determined by the first argument
+  285   Tree ->
+  286   Tree
+  287 partialSvg alpha | alpha >= 1 = id
+  288 partialSvg alpha = mapTree worker
+  289   where
+  290     worker (PathTree path) =
+  291       PathTree $ path & pathDefinition %~ lineToPath . partialLine alpha . toLineCommands
+  292     worker t = t
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Svg.Unuse.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Svg.Unuse.hs.html new file mode 100644 index 0000000..cfb9aeb --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Svg.Unuse.hs.html @@ -0,0 +1,92 @@ + + + + + + +
+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
+   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 & documentElements %~ 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 (defaultSvg & groupChildren .~ [tree])
+   35           & transform ?~
+   36               fromMaybe [] (use^.transform) ++
+   37               [baseToTransformation (use^.useBase)]
+   38     replace x = x
+   39     baseToTransformation (x,y) =
+   40       case (toUserUnit defaultDPI x, toUserUnit defaultDPI y) of
+   41         (Num a, Num b) -> Translate a b
+   42         _              -> TransformUnknown
+   43     docTree = mkGroup (doc^.documentElements)
+   44     idMap = foldTree updMap Map.empty docTree
+   45     updMap m tree =
+   46       case tree^.attrId of
+   47         Nothing  -> m
+   48         Just tid -> Map.insert tid tree m
+   49 
+   50 -- FIXME: the viewbox is ignored. Can we use the viewbox as a mask?
+   51 -- | Transform out viewbox. Definitions and CSS rules are discarded.
+   52 unbox :: Document -> Tree
+   53 unbox doc@Document{_documentViewBox = Just (_minx, _minw, _width, _height)} =
+   54   groupTree $ defaultSvg
+   55           & groupChildren .~ doc^.documentElements
+   56 unbox doc =
+   57   groupTree $ defaultSvg
+   58     & groupChildren .~ doc^.documentElements
+   59 
+   60 -- | Embed 'Document'. This keeps the entire document intact but makes
+   61 --   it more difficult to use, say, `Reanimate.Svg.pathify` on it.
+   62 embedDocument :: Document -> Tree
+   63 embedDocument doc =
+   64   translate (-screenWidth/2) (screenHeight/2) $
+   65   withFillOpacity 1 $
+   66   withStrokeWidth 0 $
+   67   flipYAxis $
+   68   svgTree $ doc & documentWidth .~ Nothing
+   69                 & documentHeight .~ Nothing
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Svg.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Svg.hs.html new file mode 100644 index 0000000..bfe0cba --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Svg.hs.html @@ -0,0 +1,370 @@ + + + + + + +
+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
+   20 import           Linear.V2                    hiding (angle)
+   21 import           Reanimate.Constants
+   22 import           Reanimate.Animation (SVG)
+   23 import           Reanimate.Svg.Constructors
+   24 import           Reanimate.Svg.LineCommand
+   25 import           Reanimate.Svg.BoundingBox
+   26 import           Reanimate.Svg.Unuse
+   27 import qualified Reanimate.Transform          as Transform
+   28 
+   29 -- | Remove transformations (such as translations, rotations, scaling)
+   30 --   and apply them directly to the SVG nodes. Note, this function
+   31 --   may convert nodes (such as Circle or Rect) to paths. Also note
+   32 --   that /does/ change how the SVG is rendered. Particularly, stroke
+   33 --   width is affected by directly applying scaling.
+   34 --
+   35 --   @lowerTransformations (scale 2 (mkCircle 1)) = mkCircle 2@
+   36 lowerTransformations :: SVG -> SVG
+   37 lowerTransformations = worker False Transform.identity
+   38   where
+   39     updLineCmd m cmd =
+   40       case cmd of
+   41         LineMove p    -> LineMove $ Transform.transformPoint m p
+   42         -- LineDraw p -> LineDraw $ Transform.transformPoint m p
+   43         LineBezier ps -> LineBezier $ map (Transform.transformPoint m) ps
+   44         LineEnd p     -> LineEnd $ Transform.transformPoint m p
+   45     updPath m = lineToPath . map (updLineCmd m) . toLineCommands
+   46     updPoint m (Num a,Num b) =
+   47       case Transform.transformPoint m (V2 a b) of
+   48         V2 x y -> (Num x, Num y)
+   49     updPoint _ other = other -- XXX: Can we do better here?
+   50     worker hasPathified m t =
+   51       let m' = m * Transform.mkMatrix (t^.transform) in
+   52       case t of
+   53         PathTree path -> PathTree $
+   54           path & pathDefinition %~ updPath m'
+   55                & transform .~ Nothing
+   56         GroupTree g -> GroupTree $
+   57           g & groupChildren %~ map (worker hasPathified m')
+   58             & transform .~ Nothing
+   59         LineTree line ->
+   60           LineTree $
+   61             line & linePoint1 %~ updPoint m
+   62                  & linePoint2 %~ updPoint m
+   63         ClipPathTree{} -> t
+   64         -- If we encounter an unknown node and we've already tried to convert
+   65         -- to paths, give up and insert an explicit transformation.
+   66         _ | hasPathified ->
+   67           mkGroup [t] & transform ?~ [ Transform.toTransformation m ]
+   68         -- If we haven't tried to pathify, run pathify only once.
+   69         _ -> worker True m (pathify t)
+   70 
+   71 -- | Remove all @id@ attributes.
+   72 lowerIds :: SVG -> SVG
+   73 lowerIds = mapTree worker
+   74   where
+   75     worker t@GroupTree{} = t & attrId .~ Nothing
+   76     worker t@PathTree{}  = t & attrId .~ Nothing
+   77     worker t             = t
+   78 
+   79 -- | Optimize SVG tree without affecting how it is rendered.
+   80 simplify :: SVG -> SVG
+   81 simplify root =
+   82   case worker root of
+   83     []  -> None
+   84     [x] -> x
+   85     xs  -> mkGroup xs
+   86   where
+   87     worker None = []
+   88     worker (DefinitionTree d) =
+   89       concatMap dropNulls
+   90       [DefinitionTree $ d & groupChildren %~ concatMap worker]
+   91     worker (GroupTree g)
+   92       | g^.drawAttributes == defaultSvg =
+   93         concatMap dropNulls $
+   94         concatMap worker (g^.groupChildren)
+   95       | otherwise =
+   96         dropNulls $
+   97         GroupTree $ g & groupChildren %~ concatMap worker
+   98     worker t = dropNulls t
+   99 
+  100     dropNulls None = []
+  101     dropNulls (DefinitionTree d)
+  102       | null (d^.groupChildren) = []
+  103     dropNulls (GroupTree g)
+  104       | null (g^.groupChildren) = []
+  105     dropNulls t = [t]
+  106 
+  107 -- | Separate grouped items. This is required by clip nodes.
+  108 --
+  109 -- @removeGroups (withFillColor "blue" $ mkGroup [mkCircle 1, mkRect 1 1])
+  110 --    = [ withFillColor "blue" $ mkCircle 1
+  111 --      , withFillColor "blue" $ mkRect 1 1 ]@
+  112 removeGroups :: SVG -> [SVG]
+  113 removeGroups = worker defaultSvg
+  114   where
+  115     worker _attr None = []
+  116     worker _attr (DefinitionTree d) =
+  117       concatMap dropNulls
+  118       [DefinitionTree $ d & groupChildren %~ concatMap (worker defaultSvg)]
+  119     worker attr (GroupTree g)
+  120       | g^.drawAttributes == defaultSvg =
+  121         concatMap dropNulls $
+  122         concatMap (worker attr) (g^.groupChildren)
+  123       | otherwise =
+  124         concatMap (worker (attr <> g^.drawAttributes)) (g^.groupChildren)
+  125     worker attr t = dropNulls (t & drawAttributes .~ attr)
+  126 
+  127     dropNulls None = []
+  128     dropNulls (DefinitionTree d)
+  129       | null (d^.groupChildren) = []
+  130     dropNulls (GroupTree g)
+  131       | null (g^.groupChildren) = []
+  132     dropNulls t = [t]
+  133 
+  134 -- | Extract all path commands from a node (and its children) and concatenate them.
+  135 extractPath :: SVG -> [PathCommand]
+  136 extractPath = worker . simplify . lowerTransformations . pathify
+  137   where
+  138     worker (GroupTree g) = concatMap worker (g^.groupChildren)
+  139     worker (PathTree p)  = p^.pathDefinition
+  140     worker _             = []
+  141 
+  142 -- | Map over indexed symbols.
+  143 --
+  144 --   @withSubglyphs [0,2] (scale 2) (mkGroup [mkCircle 1, mkRect 2, mkEllipse 1 2])
+  145 --      = mkGroup [scale 2 (mkCircle 1), mkRect 2, scale 2 (mkEllipse 1 2)]@
+  146 withSubglyphs :: [Int] -> (SVG -> SVG) -> SVG -> SVG
+  147 withSubglyphs target fn = \t -> evalState (worker t) 0
+  148   where
+  149     worker :: Tree -> State Int Tree
+  150     worker t =
+  151       case t of
+  152         GroupTree g -> do
+  153           cs <- mapM worker (g ^. groupChildren)
+  154           return $ GroupTree $ g & groupChildren .~ cs
+  155         PathTree{} -> handleGlyph t
+  156         CircleTree{} -> handleGlyph t
+  157         PolyLineTree{} -> handleGlyph t
+  158         PolygonTree{} -> handleGlyph t
+  159         EllipseTree{} -> handleGlyph t
+  160         LineTree{} -> handleGlyph t
+  161         RectangleTree{} -> handleGlyph t
+  162         _ -> return t
+  163     handleGlyph :: Tree -> State Int Tree
+  164     handleGlyph svg = do
+  165       n <- get <* modify (+1)
+  166       if n `elem` target
+  167         then return $ fn svg
+  168         else return svg
+  169 
+  170 -- | Split symbols.
+  171 --
+  172 --   @splitGlyphs [0,2] (mkGroup [mkCircle 1, mkRect 2, mkEllipse 1 2])
+  173 --      = ([mkRect 2], [mkCircle 1, mkEllipse 1 2])@
+  174 splitGlyphs :: [Int] -> SVG -> (SVG, SVG)
+  175 splitGlyphs target = \t ->
+  176     let (_, l, r) = execState (worker id t) (0, [], [])
+  177     in (mkGroup l, mkGroup r)
+  178   where
+  179     handleGlyph :: SVG -> State (Int, [SVG], [SVG]) ()
+  180     handleGlyph t = do
+  181       (n, l, r) <- get
+  182       if n `elem` target
+  183         then put (n+1, l, t:r)
+  184         else put (n+1, t:l, r)
+  185     worker :: (SVG -> SVG) -> SVG -> State (Int, [SVG], [SVG]) ()
+  186     worker acc t =
+  187       case t of
+  188         GroupTree g -> do
+  189           let acc' sub = acc (GroupTree $ g & groupChildren .~ [sub])
+  190           mapM_ (worker acc') (g ^. groupChildren)
+  191         PathTree{} -> handleGlyph $ acc t
+  192         CircleTree{} -> handleGlyph $ acc t
+  193         PolyLineTree{} -> handleGlyph $ acc t
+  194         PolygonTree{} -> handleGlyph $ acc t
+  195         EllipseTree{} -> handleGlyph $ acc t
+  196         LineTree{} -> handleGlyph $ acc t
+  197         RectangleTree{} -> handleGlyph $ acc t
+  198         DefinitionTree{} -> return ()
+  199         _ ->
+  200           modify $ \(n, l, r) -> (n, acc t:l, r)
+  201 {-
+  202 <g transform="translate(10,10)">
+  203   <g transform="scale(2)">
+  204     <circle/>
+  205   </g>
+  206   <g transform="scale(0.5)">
+  207     <rect/>
+  208   </g>
+  209 </g>
+  210 
+  211 [ (\svg -> <g transform="translate(10,10)"><g transform="scale(2)">svg</g></g>, <circle/>)
+  212 , (\svg -> <g transform="translate(10,10)"><g transform="scale(0.5)">svg</g></g>, <rect/>)]
+  213 -}
+  214 -- | Split symbols and include their context and drawing attributes.
+  215 svgGlyphs :: SVG -> [(SVG -> SVG, DrawAttributes, SVG)]
+  216 svgGlyphs = worker id defaultSvg
+  217   where
+  218     worker acc attr =
+  219       \case
+  220         None -> []
+  221         GroupTree g ->
+  222           let acc' sub = acc (GroupTree $ g & groupChildren .~ [sub])
+  223               attr' = (g^.drawAttributes) `mappend` attr
+  224           in concatMap (worker acc' attr') (g ^. groupChildren)
+  225         t -> [(acc, (t^.drawAttributes) `mappend` attr, t)]
+  226 
+  227 {-| Convert primitive SVG shapes (like those created by 'mkCircle', 'mkRect', 'mkLine' or
+  228     'mkEllipse') into SVG path. This can be useful for creating animations of these shapes being
+  229     drawn progressively with 'partialSvg'.
+  230 
+  231     Example:
+  232 
+  233     > pathifyExample :: Animation
+  234     > pathifyExample = animate $ \t -> gridLayout
+  235     >     [ [ partialSvg t $ pathify $ mkCircle 1
+  236     >       , partialSvg t $ pathify $ mkRect 2 2
+  237     >       ]
+  238     >     , [ partialSvg t $ pathify $ mkEllipse 1 0.5
+  239     >       , partialSvg t $ pathify $ mkLine (-1, -1) (1, 1)
+  240     >       ]
+  241     >     ]
+  242 
+  243     <<docs/gifs/doc_pathify.gif>>
+  244  -}
+  245 pathify :: SVG -> SVG
+  246 pathify = mapTree worker
+  247   where
+  248     worker =
+  249       \case
+  250         RectangleTree rect | Just (x,y,w,h) <- unpackRect rect ->
+  251           PathTree $ defaultSvg
+  252             & drawAttributes .~ rect ^. drawAttributes
+  253             & strokeLineCap .~ pure CapSquare
+  254             & pathDefinition .~
+  255               [MoveTo OriginAbsolute [V2 x y]
+  256               ,HorizontalTo OriginRelative [w]
+  257               ,VerticalTo OriginRelative [h]
+  258               ,HorizontalTo OriginRelative [-w]
+  259               ,EndPath ]
+  260         LineTree line | Just (x1,y1, x2, y2) <- unpackLine line ->
+  261           PathTree $ defaultSvg
+  262             & drawAttributes .~ line ^. drawAttributes
+  263             & pathDefinition .~
+  264               [MoveTo OriginAbsolute [V2 x1 y1]
+  265               ,LineTo OriginAbsolute [V2 x2 y2] ]
+  266         CircleTree circ | Just (x, y, r) <- unpackCircle circ ->
+  267           PathTree $ defaultSvg
+  268             & drawAttributes .~ circ ^. drawAttributes
+  269             & pathDefinition .~
+  270               [MoveTo OriginAbsolute [V2 (x-r) y]
+  271               ,EllipticalArc OriginRelative [(r, r, 0,True,False,V2 (r*2) 0)
+  272                                             ,(r, r, 0,True,False,V2 (-r*2) 0)]]
+  273         PolyLineTree pl ->
+  274           let points = pl ^. polyLinePoints
+  275           in PathTree $ defaultSvg
+  276                & drawAttributes .~ pl ^. drawAttributes
+  277                & pathDefinition .~ pointsToPathCommands points
+  278         PolygonTree pg ->
+  279           let points = pg ^. polygonPoints
+  280           in PathTree $ defaultSvg
+  281                & drawAttributes .~ pg ^. drawAttributes
+  282                -- Polygon automatically connects the last point to the first. For path we must do
+  283                -- it explicitly
+  284                & pathDefinition .~ (pointsToPathCommands points ++ [EndPath])
+  285         EllipseTree elip | Just (cx,cy,rx,ry) <- unpackEllipse elip ->
+  286           PathTree $ defaultSvg
+  287              & drawAttributes .~ elip ^. drawAttributes
+  288              & pathDefinition .~
+  289                [ MoveTo OriginAbsolute [V2 (cx-rx) cy]
+  290                , EllipticalArc OriginRelative [(rx, ry, 0,True,False,V2 (rx*2) 0)
+  291                                               ,(rx, ry, 0,True,False,V2 (-rx*2) 0)]]
+  292         t -> t
+  293     unpackCircle circ = do
+  294       let (x,y) = circ ^. circleCenter
+  295       liftM3 (,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ circ ^. circleRadius)
+  296     unpackEllipse elip = do
+  297       let (x,y) = elip ^. ellipseCenter
+  298       liftM4 (,,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ elip ^. ellipseXRadius)
+  299                   (unpackNumber $ elip ^. ellipseYRadius)
+  300     unpackLine line = do
+  301       let (x1,y1) = line ^. linePoint1
+  302           (x2,y2) = line ^. linePoint2
+  303       liftM4 (,,,) (unpackNumber x1) (unpackNumber y1) (unpackNumber x2) (unpackNumber y2)
+  304     unpackRect rect = do
+  305       let (x', y') = rect ^. rectUpperLeftCorner
+  306       x <- unpackNumber x'
+  307       y <- unpackNumber y'
+  308       w <- unpackNumber =<< rect ^. rectWidth
+  309       h <- unpackNumber =<< rect ^. rectHeight
+  310       return (x,y,w,h)
+  311     pointsToPathCommands points = case points of
+  312       [] -> []
+  313       (p:ps) -> [ MoveTo OriginAbsolute [p]
+  314                 , LineTo OriginAbsolute ps ]
+  315     unpackNumber n =
+  316       case toUserUnit defaultDPI n of
+  317         Num d -> Just d
+  318         _     -> Nothing
+  319 
+  320 -- | Map over all recursively-found path commands.
+  321 mapSvgPaths :: ([PathCommand] -> [PathCommand]) -> SVG -> SVG
+  322 mapSvgPaths fn = mapTree worker
+  323   where
+  324     worker =
+  325       \case
+  326         PathTree path -> PathTree $
+  327           path & pathDefinition %~ fn
+  328         t -> t
+  329 
+  330 -- | Map over all recursively-found line commands.
+  331 mapSvgLines :: ([LineCommand] -> [LineCommand]) -> SVG -> SVG
+  332 mapSvgLines fn = mapSvgPaths (lineToPath . fn . toLineCommands)
+  333 
+  334 -- Only maps points in paths
+  335 -- | Map over all line command control points.
+  336 mapSvgPoints :: (RPoint -> RPoint) -> SVG -> SVG
+  337 mapSvgPoints fn = mapSvgLines (map worker)
+  338   where
+  339     worker (LineMove p) = LineMove (fn p)
+  340     worker (LineBezier ps) = LineBezier (map fn ps)
+  341     worker (LineEnd p) = LineEnd (fn p)
+  342 
+  343 -- | Convert coordinate system from degrees to radians.
+  344 svgPointsToRadians :: SVG -> SVG
+  345 svgPointsToRadians = mapSvgPoints worker
+  346   where
+  347     worker (V2 x y) = V2 (x/180*pi) (y/180*pi)
+
+
+ + diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Transform.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Transform.hs.html new file mode 100644 index 0000000..a1b9996 --- /dev/null +++ b/reanimate-1.0.0.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-1.0.0.0-inplace/Reanimate.Transition.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Transition.hs.html new file mode 100644 index 0000000..c18c28d --- /dev/null +++ b/reanimate-1.0.0.0-inplace/Reanimate.Transition.hs.html @@ -0,0 +1,105 @@ + + + + + + +
+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 -- @
+   39 -- 'overlapT' 0.5 'fadeT' 'Reanimate.Builtin.Documentation.drawBox' 'Reanimate.Builtin.Documentation.drawCircle'
+   40 -- @
+   41 --
+   42 --   <<docs/gifs/doc_overlapT.gif>>
+   43 overlapT :: Double -> Transition -> Transition
+   44 overlapT overlap t a b =
+   45     aBefore `seqA` t aOverlap bOverlap `seqA` bAfter
+   46   where
+   47     aBefore  = takeA (duration a - overlap) a
+   48     aOverlap = lastA overlap a
+   49     bOverlap = takeA overlap b
+   50     bAfter   = dropA overlap b
+   51 
+   52 
+   53 -- | Create a transition between two animations by applying an effect to each respective animation.
+   54 effectT :: Effect -- ^ Effect to be applied to the first animation.
+   55         -> Effect -- ^ Effect to be applied to the second animation.
+   56         -> Transition
+   57 effectT eA eB a b = applyE eA a `parA` applyE eB b
+   58 
+   59 -- | Combine a list of animations using a given transition.
+   60 --
+   61 --   Example:
+   62 --
+   63 -- @
+   64 -- 'chainT' ('overlapT' 0.5 'fadeT') ['Reanimate.Builtin.Documentation.drawBox', 'Reanimate.Builtin.Documentation.drawCircle', 'Reanimate.Builtin.Documentation.drawProgress']
+   65 -- @
+   66 --
+   67 --   <<docs/gifs/doc_chainT.gif>>
+   68 chainT :: Transition -> [Animation] -> Animation
+   69 chainT _ [] = pause 0
+   70 chainT t (x:xs) = foldl t x xs
+   71 
+   72 -- | Fade out left-hand-side animation while fading in right-hand-side animation.
+   73 --
+   74 --   Example:
+   75 --
+   76 -- @
+   77 -- 'Reanimate.Builtin.Documentation.drawBox' `'fadeT'` 'Reanimate.Builtin.Documentation.drawCircle'
+   78 -- @
+   79 --
+   80 --   <<docs/gifs/doc_fadeT.gif>>
+   81 fadeT :: Transition
+   82 fadeT = effectT fadeOutE fadeInE
+
+
+ +
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
  module reanimate-0.5.0.1-inplace/Reanimate.Builtin.Documentation  module reanimate-1.0.0.0-inplace/Reanimate.Builtin.Documentation 100%6/6
- 0/0 100%117/117
  module reanimate-0.5.0.1-inplace/Reanimate.Builtin.Slide  module reanimate-1.0.0.0-inplace/Reanimate.Builtin.Slide 100%3/3
- 0/0 90%54/60
  module reanimate-0.5.0.1-inplace/Reanimate.ColorMap  module reanimate-1.0.0.0-inplace/Reanimate.ColorMap 100%14/14
60%3/5
99%1176/1180
  module reanimate-0.5.0.1-inplace/Reanimate.Transition  module reanimate-1.0.0.0-inplace/Reanimate.Transition 100%6/6
50%1/2
95%43/45
  module reanimate-0.5.0.1-inplace/Reanimate.Animation  module reanimate-1.0.0.0-inplace/Reanimate.Animation 90%28/31
57%8/14
87%298/341
  module reanimate-0.5.0.1-inplace/Reanimate.Scene.Var  module reanimate-1.0.0.0-inplace/Reanimate.Scene.Var 89%17/19
60%14/23
68%214/313
  module reanimate-0.5.0.1-inplace/Reanimate.Ease  module reanimate-1.0.0.0-inplace/Reanimate.Ease 87%7/8
100%4/4
96%85/88
  module reanimate-0.5.0.1-inplace/Reanimate.Scene.Sprite  module reanimate-1.0.0.0-inplace/Reanimate.Scene.Sprite 85%23/27
57%11/19
78%314/400
  module reanimate-0.5.0.1-inplace/Reanimate.Transform  module reanimate-1.0.0.0-inplace/Reanimate.Transform 83%5/6
33%4/12
45%76/166
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.LineCommand  module reanimate-1.0.0.0-inplace/Reanimate.Svg.LineCommand 80%12/15
58%43/74
70%659/937
  module reanimate-0.5.0.1-inplace/Reanimate.ColorComponents  module reanimate-1.0.0.0-inplace/Reanimate.ColorComponents 75%9/12
50%1/2
81%135/166
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.Constructors  module reanimate-1.0.0.0-inplace/Reanimate.Svg.Constructors 67%33/49
37%3/8
65%368/563
  module reanimate-0.5.0.1-inplace/Reanimate.Scene.Core  module reanimate-1.0.0.0-inplace/Reanimate.Scene.Core 66%12/18
- 0/0 72%172/236
  module reanimate-0.5.0.1-inplace/Reanimate.Builtin.Images  module reanimate-1.0.0.0-inplace/Reanimate.Builtin.Images 57%4/7
25%1/4
48%24/49
  module reanimate-0.5.0.1-inplace/Reanimate.Effect  module reanimate-1.0.0.0-inplace/Reanimate.Effect 52%9/17
66%4/6
53%67/125
  module reanimate-0.5.0.1-inplace/Reanimate.Morph.Linear  module reanimate-1.0.0.0-inplace/Reanimate.Morph.Linear 40%2/5
16%1/6
26%22/83
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.BoundingBox  module reanimate-1.0.0.0-inplace/Reanimate.Svg.BoundingBox 40%2/5
16%6/36
26%76/282
  module reanimate-0.5.0.1-inplace/Reanimate.Svg  module reanimate-1.0.0.0-inplace/Reanimate.Svg 38%5/13
18%15/80
41%323/777
  module reanimate-0.5.0.1-inplace/Reanimate.Constants  module reanimate-1.0.0.0-inplace/Reanimate.Constants 37%3/8
- 0/0 16%3/18
  module reanimate-0.5.0.1-inplace/Reanimate.LaTeX  module reanimate-1.0.0.0-inplace/Reanimate.LaTeX 33%4/12
11%1/9
7%12/167
  module reanimate-0.5.0.1-inplace/Reanimate.Morph.Common  module reanimate-1.0.0.0-inplace/Reanimate.Morph.Common 33%5/15
17%4/23
41%138/329
  module reanimate-0.5.0.1-inplace/Reanimate.Svg.Unuse  module reanimate-1.0.0.0-inplace/Reanimate.Svg.Unuse 33%1/3
0%0/14
22%28/127
  module reanimate-0.5.0.1-inplace/Reanimate.PolyShape  module reanimate-1.0.0.0-inplace/Reanimate.PolyShape 22%8/35
27%13/48
18%127/691
  module reanimate-0.5.0.1-inplace/Paths_reanimate  module reanimate-1.0.0.0-inplace/Paths_reanimate 20%3/15
- 0/0 20%12/58
  module reanimate-0.5.0.1-inplace/Geom2D.CubicBezier.Linear  module reanimate-1.0.0.0-inplace/Geom2D.CubicBezier.Linear 19%20/101
5%2/36
27%97/347
  module reanimate-0.5.0.1-inplace/Reanimate.Parameters  module reanimate-1.0.0.0-inplace/Reanimate.Parameters 15%3/20
- 0/0 14%7/49
  module reanimate-0.5.0.1-inplace/Reanimate.Raster  module reanimate-1.0.0.0-inplace/Reanimate.Raster 15%2/13
0%0/17
11%52/443
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.CLI  module reanimate-1.0.0.0-inplace/Reanimate.Driver.CLI 13%5/36
0%0/65
7%31/388
  module reanimate-0.5.0.1-inplace/Reanimate.Math.Polygon  module reanimate-1.0.0.0-inplace/Reanimate.Math.Polygon 9%8/82
5%4/75
2%59/2409
  module reanimate-0.5.0.1-inplace/Reanimate.Driver  module reanimate-1.0.0.0-inplace/Reanimate.Driver 8%1/12
1%1/55
3%9/245
  module reanimate-0.5.0.1-inplace/Reanimate.Render  module reanimate-1.0.0.0-inplace/Reanimate.Render 5%1/19
0%0/53
4%39/852
  module reanimate-0.5.0.1-inplace/Reanimate.Cache  module reanimate-1.0.0.0-inplace/Reanimate.Cache 0%0/8
0%0/12
0%0/160
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Check  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Check 0%0/21
0%0/27
0%0/396
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Compile  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Compile 0%0/2
0%0/4
0%0/64
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Magick  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Magick 0%0/1
- 0/0 0%0/12
  module reanimate-0.5.0.1-inplace/Reanimate.Driver.Server  module reanimate-1.0.0.0-inplace/Reanimate.Driver.Server 0%0/17
0%0/30
0%0/625
  module reanimate-0.5.0.1-inplace/Reanimate.Math.Common  module reanimate-1.0.0.0-inplace/Reanimate.Math.Common 0%0/26
0%0/12
0%0/407
  module reanimate-0.5.0.1-inplace/Reanimate.Math.SSSP  module reanimate-1.0.0.0-inplace/Reanimate.Math.SSSP 0%0/19
0%0/53
0%0/909
  module reanimate-0.5.0.1-inplace/Reanimate.Math.Triangulate  module reanimate-1.0.0.0-inplace/Reanimate.Math.Triangulate 0%0/5
- 0/0 0%0/139
  module reanimate-0.5.0.1-inplace/Reanimate.Misc  module reanimate-1.0.0.0-inplace/Reanimate.Misc 0%0/7
0%0/14
0%0/162
  module reanimate-0.5.0.1-inplace/Reanimate.Morph.Cache  module reanimate-1.0.0.0-inplace/Reanimate.Morph.Cache 0%0/1
0%0/4
0%0/61
  Program Coverage Total