hasufell
/
cga
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
LinearAlgebra/Vector.hs → Algebra/Vector.hs
View File

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

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)

7
Algorithms/ConvexHull.hs → Algorithms/ConvexHull/GrahamScan.hs
View File

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

29
CG2.cabal
View File

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

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)

8
Class/Defaults.hs
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

18
Gtk.hs → GUI/Gtk.hs
View File

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

0
gtk2.glade → GUI/gtk2.glade
View File

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

159
Diagram.hs → Graphics/Diagram/Plotter.hs
View File

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

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

2
Main.hs → GtkMain.hs
View File

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

7
Util.hs → MyPrelude.hs
View File

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

2
Parser/Meshparser.hs
View File

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

4
OS/FileExt.hs → System/FileSystem/FileExt.hs
View File

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