Finalize and allow drawing

Diagram.hs

@@ -0,0 +1,22 @@
+module Diagram where
+
+import Diagrams.Prelude
+import Diagrams.Backend.Cairo
+import Meshparser
+import Util
+
+
+-- |Create the Diagram from the VTable.
+diagFromVTable :: VTable -> Diagram Cairo R2
+diagFromVTable meshArr
+  = square 500 # lwG 0.05
+    `atop` position (zip (map mkPoint . filterValidCoords 0 500 $ meshArr)
+                     (repeat dot)) # moveTo (p2(-250, -250))
+    where dot           = (circle 2 :: Diagram Cairo R2) # fc black
+          mkPoint (x,y) = p2 (x,y)
+
+-- |Create the Diagram from a String.
+diagFromString :: String -> Diagram Cairo R2
+diagFromString mesh = diagFromVTable  .
+  meshToArr                           $
+  mesh

Main.hs

@@ -0,0 +1,31 @@
+import Control.Monad (void)
+import Control.Monad.IO.Class (liftIO)
+import Diagram
+import Diagrams.Prelude
+import Diagrams.Backend.Cairo
+import Diagrams.Backend.Cairo.Internal
+import Diagrams.Backend.Gtk
+import Graphics.UI.Gtk
+
+
+main :: IO ()
+main = do
+  _ <- initGUI
+  mesh <- readFile "test.obj"
+  window <- windowNew
+  da <- drawingAreaNew
+  set window [windowDefaultWidth := 700, windowDefaultHeight := 700,
+              windowTitle := "Computergrafik", containerBorderWidth := 10,
+              containerChild := da]
+  _ <- onDestroy window mainQuit
+  void $ da `on` exposeEvent $ liftIO $ do
+      dw <- widgetGetDrawWindow da
+      let (png, r) = renderDia Cairo
+                             (CairoOptions "jo.svg" (Width 600) SVG False)
+                             (diagFromString $ mesh)
+      png
+      renderWithDrawable dw r
+      return True
+  _ <- windowSetTypeHint window WindowTypeHintDialog
+  widgetShowAll window
+  mainGUI

Meshparser.hs

@@ -3,10 +3,13 @@ module Meshparser where
 import Control.Applicative
 import Parser
 
+-- |The VTable is represented by a 'Double' tuple, 2-dimensional.
+type VTable = [(Double, Double)]
+
 -- | Convert a text String with multiple vertices into
 -- an array of float tuples.
 meshToArr :: String   -- ^ the string to convert
-          -> [(Float, Float)] -- ^ the resulting float tuple
+          -> VTable   -- ^ the resulting vertice table
 meshToArr xs = fmap (\(Just (x, _)) -> x)     .
                  filter (/= Nothing)           .
                  fmap (runParser parseVertice) .
@@ -14,7 +17,7 @@ meshToArr xs = fmap (\(Just (x, _)) -> x)      .
                  xs
 
 -- | Creates a Parser that accepts a single vertice, such as 'v 1.0 2.0'.
-parseVertice :: Parser (Float, Float)
+parseVertice :: Parser (Double, Double)
 parseVertice = liftA2 (,)
-                 (char 'v' *> spaces *> posFloat)
-                 (spaces *> posFloat)
+                 (char 'v' *> spaces *> posDouble)
+                 (spaces *> posDouble)

Parser.hs

@@ -3,7 +3,7 @@ module Parser (Parser,
                satisfy,
                char,
                posInt,
-               posFloat,
+               posDouble,
                oneOrMore,
                zeroOrMore,
                spaces) where
@@ -66,8 +66,8 @@ posInt = MkParser f
         where (ns, rest) = span isDigit xs
 
 -- |Creates a Parser that accepts positive integers.
-posFloat :: Parser Float
-posFloat = read <$>
+posDouble :: Parser Double
+posDouble = read <$>
              liftA3 (\x y z -> x ++ [y] ++ z)
                     (MkParser f)
                     (char '.')

Util.hs

@@ -0,0 +1,19 @@
+module Util where
+
+
+-- |Checks whether the Coordinates are in a given range.
+inRange :: (Double, Double) -- ^ Coordinates to check
+        -> Double           -- ^ min
+        -> Double           -- ^ max
+        -> Bool             -- ^ result
+inRange (x, y) min' max'
+  | x <= max' && x >= min' && y <= max' && y >= min' = True
+  | otherwise = False
+
+
+-- |Filter the valid coordinates.
+filterValidCoords :: Double             -- ^ min
+                    -> Double             -- ^ max
+                    -> [(Double, Double)] -- ^ unfiltered
+                    -> [(Double, Double)] -- ^ filtered
+filterValidCoords min' max' = filter (\(x, y) -> inRange (x, y) min' max')