diff --git a/LinearAlgebra/Vector.hs b/Algebra/Vector.hs similarity index 94% rename from LinearAlgebra/Vector.hs rename to Algebra/Vector.hs index a2681a5..864e6a9 100644 --- a/LinearAlgebra/Vector.hs +++ b/Algebra/Vector.hs @@ -1,13 +1,10 @@ {-# OPTIONS_HADDOCK ignore-exports #-} -module LinearAlgebra.Vector where +module Algebra.Vector where +import Algebra.VectorTypes import Diagrams.TwoD.Types -type Vec = R2 -type PT = P2 -type Coord = (Double, Double) - -- |Checks whether the Point is in a given dimension. inRange :: Coord -- ^ X dimension diff --git a/Algebra/VectorTypes.hs b/Algebra/VectorTypes.hs new file mode 100644 index 0000000..dc3ac89 --- /dev/null +++ b/Algebra/VectorTypes.hs @@ -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) diff --git a/Algorithms/ConvexHull.hs b/Algorithms/ConvexHull/GrahamScan.hs similarity index 95% rename from Algorithms/ConvexHull.hs rename to Algorithms/ConvexHull/GrahamScan.hs index 9519896..57aa19f 100644 --- a/Algorithms/ConvexHull.hs +++ b/Algorithms/ConvexHull/GrahamScan.hs @@ -1,12 +1,13 @@ {-# OPTIONS_HADDOCK ignore-exports #-} -module Algorithms.ConvexHull where +module Algorithms.ConvexHull.GrahamScan where +import Algebra.Vector +import Algebra.VectorTypes import Data.List import Diagrams.TwoD.Types import Diagrams.TwoD.Vector -import Util -import LinearAlgebra.Vector +import MyPrelude -- |Find the point with the lowest Y coordinate. diff --git a/CG2.cabal b/CG2.cabal index eb91320..a348f2b 100644 --- a/CG2.cabal +++ b/CG2.cabal @@ -10,7 +10,7 @@ name: CG2 -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.0.0.1 +version: 0.0.0.9 -- A short (one-line) description of the package. synopsis: Computer graphics algorithms @@ -49,18 +49,18 @@ build-type: Simple cabal-version: >=1.10 -executable CG2 +executable Gtk -- .hs or .lhs file containing the Main module. - main-is: Main.hs + main-is: GtkMain.hs -- 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. -- 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, 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. -- hs-source-dirs: @@ -68,3 +68,22 @@ executable CG2 -- Base language which the package is written in. 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 diff --git a/CLI/Gif.hs b/CLI/Gif.hs new file mode 100644 index 0000000..bed80ba --- /dev/null +++ b/CLI/Gif.hs @@ -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) diff --git a/Class/Defaults.hs b/Class/Defaults.hs deleted file mode 100644 index 1c7db06..0000000 --- a/Class/Defaults.hs +++ /dev/null @@ -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 diff --git a/Gtk.hs b/GUI/Gtk.hs similarity index 96% rename from Gtk.hs rename to GUI/Gtk.hs index 617da7b..89054cd 100644 --- a/Gtk.hs +++ b/GUI/Gtk.hs @@ -1,19 +1,19 @@ {-# OPTIONS_HADDOCK ignore-exports #-} -module Gtk (makeGUI, gifCLI) where +module GUI.Gtk (makeGUI) where import Control.Monad.IO.Class -import Class.Defaults -import Diagram import Diagrams.Prelude import Diagrams.Backend.Cairo -import Diagrams.Backend.Cairo.CmdLine import Diagrams.Backend.Cairo.Internal +import Graphics.Diagram.Gtk +import Graphics.Diagram.Types import Graphics.UI.Gtk import Graphics.UI.Gtk.Glade +import MyPrelude import System.Directory +import System.FileSystem.FileExt import Text.Read -import OS.FileExt -- |Monolithic object passed to various GUI functions in order @@ -56,7 +56,7 @@ data MyGUI = MkMyGUI { -- |The glade file to load the UI from. gladeFile :: FilePath -gladeFile = "gtk2.glade" +gladeFile = "GUI/gtk2.glade" -- |Loads the glade file and creates the MyGUI object. @@ -85,12 +85,6 @@ makeMyGladeGUI = do 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. makeGUI :: FilePath -> IO () makeGUI startFile = do diff --git a/gtk2.glade b/GUI/gtk2.glade similarity index 100% rename from gtk2.glade rename to GUI/gtk2.glade diff --git a/GifMain.hs b/GifMain.hs new file mode 100644 index 0000000..ff17662 --- /dev/null +++ b/GifMain.hs @@ -0,0 +1,8 @@ +{-# OPTIONS_HADDOCK ignore-exports #-} + +import CLI.Gif + + +main :: IO () +main = do + gifCLI "" diff --git a/Graphics/Diagram/Gif.hs b/Graphics/Diagram/Gif.hs new file mode 100644 index 0000000..6e6342a --- /dev/null +++ b/Graphics/Diagram/Gif.hs @@ -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 diff --git a/Graphics/Diagram/Gtk.hs b/Graphics/Diagram/Gtk.hs new file mode 100644 index 0000000..13a8a20 --- /dev/null +++ b/Graphics/Diagram/Gtk.hs @@ -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 diff --git a/Diagram.hs b/Graphics/Diagram/Plotter.hs similarity index 58% rename from Diagram.hs rename to Graphics/Diagram/Plotter.hs index ea3796b..adf975a 100644 --- a/Diagram.hs +++ b/Graphics/Diagram/Plotter.hs @@ -1,104 +1,13 @@ {-# OPTIONS_HADDOCK ignore-exports #-} -module Diagram (t, - dX, - dY, - alg, - gd, - ct, - defaultProp, - diag, - diagS, - gifDiag, - gifDiagS, - whiteRect) where +module Graphics.Diagram.Plotter where -import Algorithms.ConvexHull -import Codec.Picture.Gif -import Class.Defaults +import Algebra.Vector +import Algebra.VectorTypes +import Algorithms.ConvexHull.GrahamScan import Diagrams.Backend.Cairo import Diagrams.Prelude -import LinearAlgebra.Vector -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 +import Graphics.Diagram.Types -- |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 --- 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 rect' where @@ -257,62 +166,6 @@ whiteRectB = Diag rect' 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. whiteRect :: Double -> Double -> Diagram Cairo R2 whiteRect x y = rect x y # lwG 0.00 # bg white diff --git a/Graphics/Diagram/Types.hs b/Graphics/Diagram/Types.hs new file mode 100644 index 0000000..352ad8d --- /dev/null +++ b/Graphics/Diagram/Types.hs @@ -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 diff --git a/Main.hs b/GtkMain.hs similarity index 90% rename from Main.hs rename to GtkMain.hs index 58ab775..a700c80 100644 --- a/Main.hs +++ b/GtkMain.hs @@ -1,6 +1,6 @@ {-# OPTIONS_HADDOCK ignore-exports #-} -import Gtk +import GUI.Gtk import System.Environment diff --git a/Util.hs b/MyPrelude.hs similarity index 79% rename from Util.hs rename to MyPrelude.hs index 66c6e9c..ccf652b 100644 --- a/Util.hs +++ b/MyPrelude.hs @@ -1,6 +1,11 @@ {-# 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. diff --git a/Parser/Meshparser.hs b/Parser/Meshparser.hs index 2dc5ee3..9ec3050 100644 --- a/Parser/Meshparser.hs +++ b/Parser/Meshparser.hs @@ -2,9 +2,9 @@ module Parser.Meshparser (meshToArr) where +import Algebra.VectorTypes import Control.Applicative import Diagrams.TwoD.Types -import LinearAlgebra.Vector import Parser.Core diff --git a/OS/FileExt.hs b/System/FileSystem/FileExt.hs similarity index 89% rename from OS/FileExt.hs rename to System/FileSystem/FileExt.hs index 583757b..a624423 100644 --- a/OS/FileExt.hs +++ b/System/FileSystem/FileExt.hs @@ -1,8 +1,8 @@ {-# 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.