diff --git a/Diagram.hs b/Diagram.hs new file mode 100644 index 0000000..587afbd --- /dev/null +++ b/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 diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..671f57f --- /dev/null +++ b/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 diff --git a/Meshparser.hs b/Meshparser.hs index 2d5af1a..4d03fd2 100644 --- a/Meshparser.hs +++ b/Meshparser.hs @@ -3,18 +3,21 @@ 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 -meshToArr xs = fmap (\(Just (x, _)) -> x) . +meshToArr :: String -- ^ the string to convert + -> VTable -- ^ the resulting vertice table +meshToArr xs = fmap (\(Just (x, _)) -> x) . filter (/= Nothing) . fmap (runParser parseVertice) . lines $ 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) diff --git a/Parser.hs b/Parser.hs index 7654bf0..915173b 100644 --- a/Parser.hs +++ b/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 '.') diff --git a/Util.hs b/Util.hs new file mode 100644 index 0000000..7dfa110 --- /dev/null +++ b/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')