cga/Graphics/Diagram/Gtk.hs

80 lines
2.6 KiB
Haskell
Raw Normal View History

2014-10-10 15:40:08 +00:00
{-# OPTIONS_HADDOCK ignore-exports #-}
module Graphics.Diagram.Gtk where
import Algebra.Vector(PT)
import qualified Data.ByteString.Char8 as B
import Data.List(find)
2014-10-10 15:40:08 +00:00
import Diagrams.Backend.Cairo
import Diagrams.Prelude
import Graphics.Diagram.AlgoDiags
import Graphics.Diagram.Core
2014-10-10 15:40:08 +00:00
import Graphics.Diagram.Plotter
import Parser.Meshparser
-- |Data structure that holds an algorithm identifier and it's
-- corresponding list of diagrams.
2014-12-16 23:52:07 +00:00
newtype DiagAlgo = DiagAlgo { getDiagAlgo ::
(Int -- the identifier for the algorithm
, [Diag]) -- the diagrams making up this algorithm
}
-- |Introspective data structure holding all algorithms for the
-- coordinate system.
diagAlgos :: [DiagAlgo]
diagAlgos =
2014-12-16 23:52:07 +00:00
[DiagAlgo (0, [coordPointsText, coordPoints, plotterBG])
,DiagAlgo (1, [convexHPText, convexHP, convexHLs, coordPoints, plotterBG])
,DiagAlgo (2, [polyLines, coordPointsText, coordPoints, plotterBG])
,DiagAlgo (3, [polyIntersectionText, polyIntersection,
coordPoints, polyLines, plotterBG])
,DiagAlgo (4, [quadPathSquare, squares, coordPointsText,
coordPoints, plotterBG])
,DiagAlgo (5, [kdRange, kdSquares, coordPointsText, coordPoints, plotterBG])
,DiagAlgo (6, [monotonePolys, coordPointsText, polyTriCategorizedPoints,
plotterBG])]
-- |Introspective data structure holding all algorithms for the
-- tree view.
diagTreAlgos :: [DiagAlgo]
diagTreAlgos =
2014-12-16 23:52:07 +00:00
[DiagAlgo (4, [treePretty])
,DiagAlgo (5, [kdTreeDiag])]
2014-10-10 15:40:08 +00:00
-- |Create the Diagram from the points.
diag :: DiagProp -> [DiagAlgo] -> [[PT]] -> Diagram Cairo R2
diag p das vts = maybe mempty (\x -> mkDiag x p vts)
$ mconcat
2014-12-16 23:52:07 +00:00
-- get the actual [Diag] array
<$> (snd . getDiagAlgo)
-- find the correct element from the [DiagAlgo] list
-- which corresponds to the algorithm from DiagProp
<$> find ((==) (algo p) . fst . getDiagAlgo) das
2014-10-10 15:40:08 +00:00
-- |Create the Diagram from a String which is supposed to be the contents
-- of an obj file.
diagS :: DiagProp -> B.ByteString -> Diagram Cairo R2
diagS p mesh =
diag p diagAlgos
. fmap (filterValidPT p)
2015-02-03 23:27:52 +00:00
. (\x -> if null x then [meshVertices mesh] else x)
. meshFaceVertices
$ mesh
-- |Create the tree diagram from a String which is supposed to be the contents
-- of an obj file.
diagTreeS :: DiagProp -> B.ByteString -> Diagram Cairo R2
diagTreeS p mesh =
diag p diagTreAlgos
. fmap (filterValidPT p)
2015-02-03 23:27:52 +00:00
. (\x -> if null x then [meshVertices mesh] else x)
. meshFaceVertices
$ mesh