Restructure modules
This commit is contained in:
parent
cb7d5269a0
commit
6e4c7e47c2
@ -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
10
Algebra/VectorTypes.hs
Normal 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)
|
@ -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
29
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
|
||||
|
13
CLI/Gif.hs
Normal file
13
CLI/Gif.hs
Normal 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)
|
@ -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
|
@ -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
|
8
GifMain.hs
Normal file
8
GifMain.hs
Normal file
@ -0,0 +1,8 @@
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
import CLI.Gif
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
gifCLI ""
|
40
Graphics/Diagram/Gif.hs
Normal file
40
Graphics/Diagram/Gif.hs
Normal 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
40
Graphics/Diagram/Gtk.hs
Normal 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
|
@ -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
87
Graphics/Diagram/Types.hs
Normal 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
|
@ -1,6 +1,6 @@
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
import Gtk
|
||||
import GUI.Gtk
|
||||
import System.Environment
|
||||
|
||||
|
@ -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,9 +2,9 @@
|
||||
|
||||
module Parser.Meshparser (meshToArr) where
|
||||
|
||||
import Algebra.VectorTypes
|
||||
import Control.Applicative
|
||||
import Diagrams.TwoD.Types
|
||||
import LinearAlgebra.Vector
|
||||
import Parser.Core
|
||||
|
||||
|
||||
|
@ -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.
|
Loading…
Reference in New Issue
Block a user