Finalize and allow drawing

This commit is contained in:
hasufell 2014-10-01 00:05:29 +02:00
parent 9ede6aecc0
commit 7cd62975af
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
5 changed files with 84 additions and 9 deletions

22
Diagram.hs Normal file
View File

@ -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

31
Main.hs Normal file
View File

@ -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

View File

@ -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)

View File

@ -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 '.')

19
Util.hs Normal file
View File

@ -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')