2014-10-10 15:40:08 +00:00
|
|
|
{-# OPTIONS_HADDOCK ignore-exports #-}
|
|
|
|
|
|
|
|
module Graphics.Diagram.Gif where
|
|
|
|
|
2014-12-03 21:02:42 +00:00
|
|
|
import Algebra.Vector(PT)
|
2014-12-03 20:26:35 +00:00
|
|
|
import Algorithms.GrahamScan
|
2014-10-10 15:40:08 +00:00
|
|
|
import Codec.Picture.Gif
|
2014-11-21 03:49:17 +00:00
|
|
|
import qualified Data.ByteString.Char8 as B
|
2014-10-14 19:24:21 +00:00
|
|
|
import Data.Monoid
|
2014-10-10 15:40:08 +00:00
|
|
|
import Diagrams.Backend.Cairo
|
2014-10-14 19:24:21 +00:00
|
|
|
import Diagrams.Prelude hiding ((<>))
|
2014-12-03 21:02:42 +00:00
|
|
|
import Graphics.Diagram.AlgoDiags
|
|
|
|
import Graphics.Diagram.Core
|
2014-10-10 15:40:08 +00:00
|
|
|
import Graphics.Diagram.Plotter
|
|
|
|
import Parser.Meshparser
|
|
|
|
|
|
|
|
|
|
|
|
-- |Return a list of tuples used by 'gifMain' to generate an animated gif.
|
|
|
|
gifDiag :: DiagProp -> [PT] -> [(Diagram Cairo R2, GifDelay)]
|
|
|
|
gifDiag p xs =
|
2014-10-25 21:54:07 +00:00
|
|
|
fmap ((\x -> (x, 50)) . (<> nonChDiag))
|
|
|
|
(upperHullList
|
|
|
|
<> fmap (<> last upperHullList) lowerHullList
|
|
|
|
<> [mkDiag (mconcat [convexHPText, convexHP, convexHLs])
|
2014-12-07 03:33:45 +00:00
|
|
|
p{ showCoordText = True } [xs]])
|
2014-10-10 15:40:08 +00:00
|
|
|
where
|
2014-10-25 21:54:07 +00:00
|
|
|
upperHullList = mkGifDiag convexHStepsLs p purple grahamUHSteps xs
|
|
|
|
lowerHullList = mkGifDiag convexHStepsLs p orange grahamLHSteps xs
|
2014-10-10 15:40:08 +00:00
|
|
|
-- add the x-axis and the other default stuff
|
|
|
|
nonChDiag =
|
2015-01-09 03:05:43 +00:00
|
|
|
mconcat
|
|
|
|
. fmap (\x -> mkDiag x p [xs])
|
|
|
|
$ [coordPoints, plotterBG]
|
2014-10-10 15:40:08 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- |Same as gifDiag, except that it takes a string containing the
|
|
|
|
-- mesh file content instead of the the points.
|
2014-11-21 03:49:17 +00:00
|
|
|
gifDiagS :: DiagProp -> B.ByteString -> [(Diagram Cairo R2, GifDelay)]
|
2015-02-03 23:27:52 +00:00
|
|
|
gifDiagS p = gifDiag p . filterValidPT p . meshVertices
|