Restructure modules

This commit is contained in:
hasufell 2014-10-10 17:40:08 +02:00
parent cb7d5269a0
commit 6e4c7e47c2
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
17 changed files with 250 additions and 191 deletions

View File

@ -1,13 +1,10 @@
{-# OPTIONS_HADDOCK ignore-exports #-} {-# OPTIONS_HADDOCK ignore-exports #-}
module LinearAlgebra.Vector where module Algebra.Vector where
import Algebra.VectorTypes
import Diagrams.TwoD.Types import Diagrams.TwoD.Types
type Vec = R2
type PT = P2
type Coord = (Double, Double)
-- |Checks whether the Point is in a given dimension. -- |Checks whether the Point is in a given dimension.
inRange :: Coord -- ^ X dimension inRange :: Coord -- ^ X dimension

10
Algebra/VectorTypes.hs Normal file
View File

@ -0,0 +1,10 @@
{-# OPTIONS_HADDOCK ignore-exports #-}
module Algebra.VectorTypes where
import Diagrams.TwoD.Types
type Vec = R2
type PT = P2
type Coord = (Double, Double)

View File

@ -1,12 +1,13 @@
{-# OPTIONS_HADDOCK ignore-exports #-} {-# OPTIONS_HADDOCK ignore-exports #-}
module Algorithms.ConvexHull where module Algorithms.ConvexHull.GrahamScan where
import Algebra.Vector
import Algebra.VectorTypes
import Data.List import Data.List
import Diagrams.TwoD.Types import Diagrams.TwoD.Types
import Diagrams.TwoD.Vector import Diagrams.TwoD.Vector
import Util import MyPrelude
import LinearAlgebra.Vector
-- |Find the point with the lowest Y coordinate. -- |Find the point with the lowest Y coordinate.

View File

@ -10,7 +10,7 @@ name: CG2
-- PVP summary: +-+------- breaking API changes -- PVP summary: +-+------- breaking API changes
-- | | +----- non-breaking API additions -- | | +----- non-breaking API additions
-- | | | +--- code changes with no API change -- | | | +--- code changes with no API change
version: 0.0.0.1 version: 0.0.0.9
-- A short (one-line) description of the package. -- A short (one-line) description of the package.
synopsis: Computer graphics algorithms synopsis: Computer graphics algorithms
@ -49,18 +49,18 @@ build-type: Simple
cabal-version: >=1.10 cabal-version: >=1.10
executable CG2 executable Gtk
-- .hs or .lhs file containing the Main module. -- .hs or .lhs file containing the Main module.
main-is: Main.hs main-is: GtkMain.hs
-- Modules included in this executable, other than Main. -- Modules included in this executable, other than Main.
other-modules: Diagram Gtk Util Class.Defaults Parser.Meshparser Parser.Core OS.FileExt LinearAlgebra.Vector Algorithms.ConvexHull other-modules: MyPrelude GUI.Gtk Graphics.Diagram.Gif Graphics.Diagram.Gtk Graphics.Diagram.Types Graphics.Diagram.Plotter Parser.Meshparser Parser.Core System.FileSystem.FileExt Algebra.Vector Algorithms.ConvexHull.GrahamScan
-- LANGUAGE extensions used by modules in this package. -- LANGUAGE extensions used by modules in this package.
-- other-extensions: -- other-extensions:
-- Other library packages from which modules are imported. -- Other library packages from which modules are imported.
build-depends: base >=4.6 && <4.8, diagrams-lib >=1.2 && <1.3, diagrams-cairo >=1.2 && <1.3, transformers >=0.4 && <0.5, glade >=0.12 && <0.13, gtk >=0.12 && <0.13, directory >=1.2 && <1.3, JuicyPixels >= 3.1.7.1 build-depends: base >=4.6 && <4.8, diagrams-lib >=1.2 && <1.3, diagrams-cairo >=1.2 && <1.3, transformers >=0.4 && <0.5, glade >=0.12 && <0.13, gtk >=0.12 && <0.13, directory >=1.2 && <1.3
-- Directories containing source files. -- Directories containing source files.
-- hs-source-dirs: -- hs-source-dirs:
@ -68,3 +68,22 @@ executable CG2
-- Base language which the package is written in. -- Base language which the package is written in.
default-language: Haskell2010 default-language: Haskell2010
executable Gif
-- .hs or .lhs file containing the Main module.
main-is: GifMain.hs
-- Modules included in this executable, other than Main.
other-modules: MyPrelude Graphics.Diagram.Gif Graphics.Diagram.Types Graphics.Diagram.Plotter Parser.Meshparser Parser.Core System.FileSystem.FileExt Algebra.Vector Algorithms.ConvexHull.GrahamScan
-- LANGUAGE extensions used by modules in this package.
-- other-extensions:
-- Other library packages from which modules are imported.
build-depends: base >=4.6 && <4.8, diagrams-lib >=1.2 && <1.3, diagrams-cairo >=1.2 && <1.3, transformers >=0.4 && <0.5, JuicyPixels >= 3.1.7.1
-- Directories containing source files.
-- hs-source-dirs:
-- Base language which the package is written in.
default-language: Haskell2010

13
CLI/Gif.hs Normal file
View File

@ -0,0 +1,13 @@
{-# OPTIONS_HADDOCK ignore-exports #-}
module CLI.Gif where
import Diagrams.Backend.Cairo.CmdLine
import Graphics.Diagram.Gif
import MyPrelude
gifCLI :: FilePath -> IO ()
gifCLI _ = do
mesh <- readFile "UB1_sonderfaelle.obj"
gifMain (gifDiagS def mesh)

View File

@ -1,8 +0,0 @@
{-# OPTIONS_HADDOCK ignore-exports #-}
module Class.Defaults where
-- |Used to create a common interface for default settings of data types.
class Def a where
def :: a

View File

@ -1,19 +1,19 @@
{-# OPTIONS_HADDOCK ignore-exports #-} {-# OPTIONS_HADDOCK ignore-exports #-}
module Gtk (makeGUI, gifCLI) where module GUI.Gtk (makeGUI) where
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Class.Defaults
import Diagram
import Diagrams.Prelude import Diagrams.Prelude
import Diagrams.Backend.Cairo import Diagrams.Backend.Cairo
import Diagrams.Backend.Cairo.CmdLine
import Diagrams.Backend.Cairo.Internal import Diagrams.Backend.Cairo.Internal
import Graphics.Diagram.Gtk
import Graphics.Diagram.Types
import Graphics.UI.Gtk import Graphics.UI.Gtk
import Graphics.UI.Gtk.Glade import Graphics.UI.Gtk.Glade
import MyPrelude
import System.Directory import System.Directory
import System.FileSystem.FileExt
import Text.Read import Text.Read
import OS.FileExt
-- |Monolithic object passed to various GUI functions in order -- |Monolithic object passed to various GUI functions in order
@ -56,7 +56,7 @@ data MyGUI = MkMyGUI {
-- |The glade file to load the UI from. -- |The glade file to load the UI from.
gladeFile :: FilePath gladeFile :: FilePath
gladeFile = "gtk2.glade" gladeFile = "GUI/gtk2.glade"
-- |Loads the glade file and creates the MyGUI object. -- |Loads the glade file and creates the MyGUI object.
@ -85,12 +85,6 @@ makeMyGladeGUI = do
xl' xu' yl' yu' aD' cB' gC' cC' xl' xu' yl' yu' aD' cB' gC' cC'
gifCLI :: FilePath -> IO ()
gifCLI _ = do
mesh <- readFile "UB1_sonderfaelle.obj"
gifMain (gifDiagS def mesh)
-- |Main entry point for the GTK GUI routines. -- |Main entry point for the GTK GUI routines.
makeGUI :: FilePath -> IO () makeGUI :: FilePath -> IO ()
makeGUI startFile = do makeGUI startFile = do

8
GifMain.hs Normal file
View File

@ -0,0 +1,8 @@
{-# OPTIONS_HADDOCK ignore-exports #-}
import CLI.Gif
main :: IO ()
main = do
gifCLI ""

40
Graphics/Diagram/Gif.hs Normal file
View File

@ -0,0 +1,40 @@
{-# OPTIONS_HADDOCK ignore-exports #-}
module Graphics.Diagram.Gif where
import Algebra.VectorTypes
import Codec.Picture.Gif
import Diagrams.Backend.Cairo
import Diagrams.Prelude
import Graphics.Diagram.Plotter
import Graphics.Diagram.Types
import Parser.Meshparser
-- |Return a list of tuples used by 'gifMain' to generate an animated gif.
gifDiag :: DiagProp -> [PT] -> [(Diagram Cairo R2, GifDelay)]
gifDiag p xs =
fmap (\x -> (x, 100)) .
fmap (\x -> x <> nonChDiag) .
flip (++)
[mkDiag (convexHullPointsText `mappend`
convexHullLines `mappend`
convexHullPoints)
p xs] $
(convexHullLinesInterval p xs)
where
-- add the x-axis and the other default stuff
nonChDiag =
mconcat .
fmap (\x -> mkDiag x p xs) $
[coordPoints,
xAxis,
yAxis,
grid,
whiteRectB]
-- |Same as gifDiag, except that it takes a string containing the
-- mesh file content instead of the the points.
gifDiagS :: DiagProp -> MeshString -> [(Diagram Cairo R2, GifDelay)]
gifDiagS p = gifDiag p . meshToArr

40
Graphics/Diagram/Gtk.hs Normal file
View File

@ -0,0 +1,40 @@
{-# OPTIONS_HADDOCK ignore-exports #-}
module Graphics.Diagram.Gtk where
import Algebra.VectorTypes
import Diagrams.Backend.Cairo
import Diagrams.Prelude
import Graphics.Diagram.Plotter
import Graphics.Diagram.Types
import Parser.Meshparser
-- |Create the Diagram from the points.
diag :: DiagProp -> [PT] -> Diagram Cairo R2
diag p = case alg p of
0 ->
mkDiag
(mconcat [maybeDiag (ct p) coordPointsText,
coordPoints, xAxis, yAxis,
maybeDiag (gd p) grid, whiteRectB])
p
1 ->
mkDiag
(mconcat
[maybeDiag (ct p) convexHullPointsText,
convexHullPoints, convexHullLines,
coordPoints, xAxis, yAxis,
maybeDiag (gd p) grid, whiteRectB])
p
_ -> mempty
-- |Create the Diagram from a String which is supposed to be the contents
-- of an obj file.
diagS :: DiagProp -> MeshString -> Diagram Cairo R2
diagS p mesh =
(diag p .
meshToArr $
mesh) #
bg white

View File

@ -1,104 +1,13 @@
{-# OPTIONS_HADDOCK ignore-exports #-} {-# OPTIONS_HADDOCK ignore-exports #-}
module Diagram (t, module Graphics.Diagram.Plotter where
dX,
dY,
alg,
gd,
ct,
defaultProp,
diag,
diagS,
gifDiag,
gifDiagS,
whiteRect) where
import Algorithms.ConvexHull import Algebra.Vector
import Codec.Picture.Gif import Algebra.VectorTypes
import Class.Defaults import Algorithms.ConvexHull.GrahamScan
import Diagrams.Backend.Cairo import Diagrams.Backend.Cairo
import Diagrams.Prelude import Diagrams.Prelude
import LinearAlgebra.Vector import Graphics.Diagram.Types
import Parser.Meshparser
type MeshString = String
-- |Represents a Cairo Diagram. This allows us to create multiple
-- diagrams with different algorithms but based on the same
-- coordinates and common properties.
data Diag = Diag {
mkDiag :: DiagProp
-> [PT]
-> Diagram Cairo R2
}
-- |Holds the properties for a Diagram, like thickness of 2d points etc.
-- This can also be seen as a context when merging multiple diagrams.
data DiagProp = MkProp {
-- |The thickness of the dots.
t :: Double,
-- |The dimensions of the x-axis.
dX :: Coord,
-- |The dimensions of the y-axis.
dY :: Coord,
-- |Algorithm to use.
alg :: Int,
-- |If we want to show the grid.
gd :: Bool,
-- |If we want to show the coordinates as text.
ct :: Bool,
-- |Square size used to show the grid and x/y-axis.
sqS :: Double
}
instance Def DiagProp where
def = defaultProp
instance Monoid Diag where
mempty = Diag (\_ _ -> mempty)
mappend d1 d2 = Diag g
where
g p vt = mkDiag d1 p vt <> mkDiag d2 p vt
mconcat = foldr mappend mempty
-- |The default properties of the Diagram.
defaultProp :: DiagProp
defaultProp = MkProp 2 (0,500) (0,500) 0 False False 50
-- |Extract the lower bound of the x-axis dimension.
xlD :: DiagProp -> Double
xlD = fst . dX
-- |Extract the upper bound of the x-axis dimension.
xuD :: DiagProp -> Double
xuD = snd . dX
-- |Extract the lower bound of the y-axis dimension.
ylD :: DiagProp -> Double
ylD = fst . dY
-- |Extract the upper bound of the y-axis dimension.
yuD :: DiagProp -> Double
yuD = snd . dY
-- |Returns the specified diagram if True is passed,
-- otherwise returns the empty diagram. This is just for convenience
-- to avoid if else constructs.
maybeDiag :: Bool -> Diag -> Diag
maybeDiag b d
| b = d
| otherwise = mempty
-- |Creates a Diagram that shows the coordinates from the points -- |Creates a Diagram that shows the coordinates from the points
@ -247,7 +156,7 @@ yAxis =
-- |Creates a Diagram that shows a white rectangle which is a little -- |Creates a Diagram that shows a white rectangle which is a little
-- bit bigger as both X and Y axis dimensions from DiagProp. -- bit bigger than both X and Y axis dimensions from DiagProp.
whiteRectB :: Diag whiteRectB :: Diag
whiteRectB = Diag rect' whiteRectB = Diag rect'
where where
@ -257,62 +166,6 @@ whiteRectB = Diag rect'
h' = yuD p - ylD p h' = yuD p - ylD p
-- |Create the Diagram from the points.
diag :: DiagProp -> [PT] -> Diagram Cairo R2
diag p = case alg p of
0 ->
mkDiag
(mconcat [maybeDiag (ct p) coordPointsText,
coordPoints, xAxis, yAxis,
maybeDiag (gd p) grid, whiteRectB])
p
1 ->
mkDiag
(mconcat
[maybeDiag (ct p) convexHullPointsText,
convexHullPoints, convexHullLines,
coordPoints, xAxis, yAxis,
maybeDiag (gd p) grid, whiteRectB])
p
_ -> mempty
-- |Create the Diagram from a String which is supposed to be the contents
-- of an obj file.
diagS :: DiagProp -> MeshString -> Diagram Cairo R2
diagS p mesh =
(diag p .
meshToArr $
mesh) #
bg white
-- |Return a list of tuples used by 'gifMain' to generate an animated gif.
gifDiag :: DiagProp -> [PT] -> [(Diagram Cairo R2, GifDelay)]
gifDiag p xs =
fmap (\x -> (x, 100)) .
fmap (\x -> x <> nonChDiag) .
flip (++)
[mkDiag (convexHullLines `mappend`
convexHullPoints) p xs] $
(convexHullLinesInterval p xs)
where
-- add the x-axis and the other default stuff
nonChDiag =
mconcat .
fmap (\x -> mkDiag x p xs) $
[coordPoints,
xAxis,
yAxis,
whiteRectB]
-- |Same as gifDiag, except that it takes a string containing the
-- mesh file content instead of the the points.
gifDiagS :: DiagProp -> MeshString -> [(Diagram Cairo R2, GifDelay)]
gifDiagS p = gifDiag p . meshToArr
-- |Create a white rectangle with the given width and height. -- |Create a white rectangle with the given width and height.
whiteRect :: Double -> Double -> Diagram Cairo R2 whiteRect :: Double -> Double -> Diagram Cairo R2
whiteRect x y = rect x y # lwG 0.00 # bg white whiteRect x y = rect x y # lwG 0.00 # bg white

87
Graphics/Diagram/Types.hs Normal file
View File

@ -0,0 +1,87 @@
{-# OPTIONS_HADDOCK ignore-exports #-}
module Graphics.Diagram.Types where
import Algebra.VectorTypes
import Diagrams.Backend.Cairo
import Diagrams.Prelude
import MyPrelude
type MeshString = String
-- |Represents a Cairo Diagram. This allows us to create multiple
-- diagrams with different algorithms but based on the same
-- coordinates and common properties.
data Diag = Diag {
mkDiag :: DiagProp
-> [PT]
-> Diagram Cairo R2
}
-- |Holds the properties for a Diagram, like thickness of 2d points etc.
-- This can also be seen as a context when merging multiple diagrams.
data DiagProp = MkProp {
-- |The thickness of the dots.
t :: Double,
-- |The dimensions of the x-axis.
dX :: Coord,
-- |The dimensions of the y-axis.
dY :: Coord,
-- |Algorithm to use.
alg :: Int,
-- |If we want to show the grid.
gd :: Bool,
-- |If we want to show the coordinates as text.
ct :: Bool,
-- |Square size used to show the grid and x/y-axis.
sqS :: Double
}
instance Def DiagProp where
def = defaultProp
instance Monoid Diag where
mempty = Diag (\_ _ -> mempty)
mappend d1 d2 = Diag g
where
g p vt = mkDiag d1 p vt <> mkDiag d2 p vt
mconcat = foldr mappend mempty
-- |The default properties of the Diagram.
defaultProp :: DiagProp
defaultProp = MkProp 2 (0,500) (0,500) 0 False False 50
-- |Extract the lower bound of the x-axis dimension.
xlD :: DiagProp -> Double
xlD = fst . dX
-- |Extract the upper bound of the x-axis dimension.
xuD :: DiagProp -> Double
xuD = snd . dX
-- |Extract the lower bound of the y-axis dimension.
ylD :: DiagProp -> Double
ylD = fst . dY
-- |Extract the upper bound of the y-axis dimension.
yuD :: DiagProp -> Double
yuD = snd . dY
-- |Returns the specified diagram if True is passed,
-- otherwise returns the empty diagram. This is just for convenience
-- to avoid if else constructs.
maybeDiag :: Bool -> Diag -> Diag
maybeDiag b d
| b = d
| otherwise = mempty

View File

@ -1,6 +1,6 @@
{-# OPTIONS_HADDOCK ignore-exports #-} {-# OPTIONS_HADDOCK ignore-exports #-}
import Gtk import GUI.Gtk
import System.Environment import System.Environment

View File

@ -1,6 +1,11 @@
{-# OPTIONS_HADDOCK ignore-exports #-} {-# OPTIONS_HADDOCK ignore-exports #-}
module Util where module MyPrelude where
-- |Used to create a common interface for default settings of data types.
class Def a where
def :: a
-- |Split an array into subarrays depending on a given condition. -- |Split an array into subarrays depending on a given condition.

View File

@ -2,9 +2,9 @@
module Parser.Meshparser (meshToArr) where module Parser.Meshparser (meshToArr) where
import Algebra.VectorTypes
import Control.Applicative import Control.Applicative
import Diagrams.TwoD.Types import Diagrams.TwoD.Types
import LinearAlgebra.Vector
import Parser.Core import Parser.Core

View File

@ -1,8 +1,8 @@
{-# OPTIONS_HADDOCK ignore-exports #-} {-# OPTIONS_HADDOCK ignore-exports #-}
module OS.FileExt where module System.FileSystem.FileExt where
import Util import MyPrelude
-- |Compare the extension of a file with the given String. -- |Compare the extension of a file with the given String.