2014-10-10 15:40:08 +00:00
|
|
|
{-# OPTIONS_HADDOCK ignore-exports #-}
|
|
|
|
|
|
|
|
module Graphics.Diagram.Gtk where
|
|
|
|
|
2015-05-21 00:14:15 +00:00
|
|
|
import Algebra.Vector
|
2014-11-21 03:49:17 +00:00
|
|
|
import qualified Data.ByteString.Char8 as B
|
2014-12-01 01:19:11 +00:00
|
|
|
import Data.List(find)
|
2014-10-10 15:40:08 +00:00
|
|
|
import Diagrams.Backend.Cairo
|
|
|
|
import Diagrams.Prelude
|
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
|
|
|
|
|
|
|
|
|
2014-12-01 01:19:11 +00:00
|
|
|
-- |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
|
|
|
|
}
|
2014-12-01 01:19:11 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- |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])
|
2015-01-07 17:55:16 +00:00
|
|
|
,DiagAlgo (5, [kdRange, kdSquares, coordPointsText, coordPoints, plotterBG])
|
2015-01-09 03:04:23 +00:00
|
|
|
,DiagAlgo (6, [monotonePolys, coordPointsText, polyTriCategorizedPoints,
|
2015-01-07 17:55:16 +00:00
|
|
|
plotterBG])]
|
2014-12-01 01:19:11 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- |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-12-01 01:19:11 +00:00
|
|
|
|
|
|
|
|
2014-10-10 15:40:08 +00:00
|
|
|
-- |Create the Diagram from the points.
|
2015-05-21 00:14:15 +00:00
|
|
|
diag :: DiagProp -> [DiagAlgo] -> [[P2 Double]] -> Diagram Cairo
|
2014-12-07 03:33:45 +00:00
|
|
|
diag p das vts = maybe mempty (\x -> mkDiag x p vts)
|
2014-12-01 01:19:11 +00:00
|
|
|
$ 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.
|
2015-05-21 00:14:15 +00:00
|
|
|
diagS :: DiagProp -> B.ByteString -> Diagram Cairo
|
2014-12-07 17:55:49 +00:00
|
|
|
diagS p mesh =
|
|
|
|
diag p diagAlgos
|
|
|
|
. fmap (filterValidPT p)
|
|
|
|
. (\x -> if null x then [meshToArr mesh] else x)
|
|
|
|
. facesToArr
|
|
|
|
$ mesh
|
2014-11-15 02:58:38 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- |Create the tree diagram from a String which is supposed to be the contents
|
|
|
|
-- of an obj file.
|
2015-05-21 00:14:15 +00:00
|
|
|
diagTreeS :: DiagProp -> B.ByteString -> Diagram Cairo
|
2014-12-07 17:55:49 +00:00
|
|
|
diagTreeS p mesh =
|
|
|
|
diag p diagTreAlgos
|
|
|
|
. fmap (filterValidPT p)
|
|
|
|
. (\x -> if null x then [meshToArr mesh] else x)
|
|
|
|
. facesToArr
|
|
|
|
$ mesh
|
|
|
|
|