DIAG: use proper introspection in Gtk logic

Graphics/Diagram/Gtk.hs

@@ -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 :: DiagProp -> [DiagAlgo] -> Object -> Diagram Cairo R2
-diag p obj@(Object _)
+diag p das obj = maybe mempty (\x -> mkDiag x p obj)
-  | algo p == 0 =
+                  $ mconcat
-      mkDiag (mconcat [coordPointsText, coordPoints, plotterBG])
+                      <$> getDiags
-             p obj
+                      <$> find (\(DiagAlgo x _) -> x == algo p) das
-  | 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
 
 
 -- |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
+      diag p diagAlgos . Objects . fmap (filterValidPT p) . facesToArr $ mesh
-      . Objects
+  | otherwise = diag p diagAlgos . Object . filterValidPT p . meshToArr $ mesh
-      . fmap (filterValidPT p)
-      . facesToArr
-      $ mesh
-  | otherwise = (diag p . Object . filterValidPT p . meshToArr $ mesh) # bg white
 
 
 -- |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
+diagTreeS p mesh = diag p diagTreAlgos
-  | algo p == 4 = mkDiag treePretty p (Object
+                     . Object
-                                       . filterValidPT p
+                     . filterValidPT p
-                                       . meshToArr
+                     . meshToArr
-                                       $ mesh)
+                     $ mesh
-  | algo p == 5 = mkDiag kdTreeDiag p (Object
-                                       . filterValidPT p
-                                       . meshToArr
-                                       $ mesh)
-  | otherwise  = mempty