DIAG: use proper introspection in Gtk logic
This commit is contained in:
parent
562f7a58e8
commit
cc9b7b6365
@ -3,6 +3,7 @@
|
||||
module Graphics.Diagram.Gtk where
|
||||
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.List(find)
|
||||
import Diagrams.Backend.Cairo
|
||||
import Diagrams.Prelude
|
||||
import Graphics.Diagram.Plotter
|
||||
@ -10,33 +11,42 @@ import Graphics.Diagram.Types
|
||||
import Parser.Meshparser
|
||||
|
||||
|
||||
-- |Data structure that holds an algorithm identifier and it's
|
||||
-- corresponding list of diagrams.
|
||||
data DiagAlgo = DiagAlgo {
|
||||
algoNum :: Int, -- the identifier for the algorithm
|
||||
getDiags :: [Diag] -- the diagrams making up this algorithm
|
||||
}
|
||||
|
||||
|
||||
-- |Introspective data structure holding all algorithms for the
|
||||
-- coordinate system.
|
||||
diagAlgos :: [DiagAlgo]
|
||||
diagAlgos =
|
||||
[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, polyLines, plotterBG]
|
||||
,DiagAlgo 5 [kdSquares, coordPointsText, coordPoints, plotterBG]]
|
||||
|
||||
|
||||
-- |Introspective data structure holding all algorithms for the
|
||||
-- tree view.
|
||||
diagTreAlgos :: [DiagAlgo]
|
||||
diagTreAlgos =
|
||||
[DiagAlgo 4 [treePretty]
|
||||
,DiagAlgo 5 [kdTreeDiag]]
|
||||
|
||||
|
||||
-- |Create the Diagram from the points.
|
||||
diag :: DiagProp -> Object -> Diagram Cairo R2
|
||||
diag p obj@(Object _)
|
||||
| algo p == 0 =
|
||||
mkDiag (mconcat [coordPointsText, coordPoints, plotterBG])
|
||||
p obj
|
||||
| algo p == 1 =
|
||||
mkDiag (mconcat [convexHPText, convexHP, convexHLs, coordPoints, plotterBG])
|
||||
p obj
|
||||
| algo p == 4 =
|
||||
mkDiag (mconcat [quadPathSquare, squares, coordPointsText,
|
||||
coordPoints, polyLines, plotterBG])
|
||||
p obj
|
||||
| algo p == 5 =
|
||||
mkDiag (mconcat [kdRange, kdSquares, coordPointsText,
|
||||
coordPoints, plotterBG])
|
||||
p obj
|
||||
| otherwise = mempty
|
||||
diag p objs@(Objects _)
|
||||
| algo p == 2 =
|
||||
mkDiag (mconcat [polyLines, coordPointsText, coordPoints, plotterBG])
|
||||
p objs
|
||||
| algo p == 3 =
|
||||
mkDiag (mconcat [polyIntersectionText, polyIntersection,
|
||||
coordPoints, polyLines, plotterBG])
|
||||
p objs
|
||||
| otherwise = mempty
|
||||
diag :: DiagProp -> [DiagAlgo] -> Object -> Diagram Cairo R2
|
||||
diag p das obj = maybe mempty (\x -> mkDiag x p obj)
|
||||
$ mconcat
|
||||
<$> getDiags
|
||||
<$> find (\(DiagAlgo x _) -> x == algo p) das
|
||||
|
||||
|
||||
-- |Create the Diagram from a String which is supposed to be the contents
|
||||
@ -44,24 +54,15 @@ diag p objs@(Objects _)
|
||||
diagS :: DiagProp -> B.ByteString -> Diagram Cairo R2
|
||||
diagS p mesh
|
||||
| algo p == 2 || algo p == 3 =
|
||||
diag p
|
||||
. Objects
|
||||
. fmap (filterValidPT p)
|
||||
. facesToArr
|
||||
$ mesh
|
||||
| otherwise = (diag p . Object . filterValidPT p . meshToArr $ mesh) # bg white
|
||||
diag p diagAlgos . Objects . fmap (filterValidPT p) . facesToArr $ mesh
|
||||
| otherwise = diag p diagAlgos . Object . filterValidPT p . meshToArr $ 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
|
||||
| algo p == 4 = mkDiag treePretty p (Object
|
||||
. filterValidPT p
|
||||
. meshToArr
|
||||
$ mesh)
|
||||
| algo p == 5 = mkDiag kdTreeDiag p (Object
|
||||
. filterValidPT p
|
||||
. meshToArr
|
||||
$ mesh)
|
||||
| otherwise = mempty
|
||||
diagTreeS p mesh = diag p diagTreAlgos
|
||||
. Object
|
||||
. filterValidPT p
|
||||
. meshToArr
|
||||
$ mesh
|
||||
|
Loading…
Reference in New Issue
Block a user