Make the diagram API more abstract

In particular we now have the data type 'Diag' which
can be used to concatenate multiple Diagrams via mconcat while
keep the properties and VTable across all of them consistent.
This commit is contained in:
hasufell 2014-10-06 21:11:28 +02:00
parent 69026edf83
commit 8547122be6
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
1 changed files with 107 additions and 27 deletions

View File

@ -7,8 +7,14 @@ import Meshparser
import Util
instance Def DiagProp where
def = defaultProp
-- |Represents a Cairo Diagram. This allow us to create multiple
-- diagrams with different algorithms but based on the same
-- coordinates and common properties.
data Diag = Diag {
mkDiag :: DiagProp -- ^ properties of the diagrams
-> VTable -- ^ coordinates from the vertice table
-> Diagram Cairo R2 -- ^ resulting cairo 2d diagram
}
-- |Holds the properties for a Diagram, like thickness of 2d points etc.
@ -18,43 +24,117 @@ data DiagProp = MkProp {
-- |The dimensions of the x-axis.
dX :: (Double, Double),
-- |The dimensions of the y-axis.
dY :: (Double, Double)
dY :: (Double, Double),
-- |Algorithm to use.
alg :: Int
}
instance Def DiagProp where
def = defaultProp
instance Monoid Diag where
mempty = Diag (\_ _ -> rect 0 0 # lwG 0.00)
mappend d1 d2 = Diag g
where
g p vt = mkDiag d1 p vt `atop` mkDiag d2 p vt
mconcat = foldr mappend mempty
-- |The default properties of the Diagram.
defaultProp :: DiagProp
defaultProp = MkProp 2 (0,500) (0,500)
defaultProp = MkProp 2 (0,500) (0,500) 0
-- |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
-- |The X offset to move coordinates to the right
-- position depending on the X dimensions.
xOffset :: DiagProp -> Double
xOffset p = (negate (xlD p) / 2) - (xuD p / 2)
-- |The Y offset to move coordinates to the right
-- position depending on the X dimensions.
yOffset :: DiagProp -> Double
yOffset p = (negate (ylD p) / 2) - (yuD p / 2)
-- |Creates a Diagram that shows the coordinates from the VTable
-- as dots. The VTable and thickness of the dots can be controlled
-- via DiagProp.
showCoordinates :: Diag
showCoordinates = Diag f
where
f p vt
= position (zip (map mkPoint . filter (inRange (dX p) (dY p)) $ vt)
(repeat dot)) # moveTo (p2(xOffset p, yOffset p))
where
-- a dot itself is a diagram
dot = (circle $ t p :: Diagram Cairo R2) # fc black
-- this is just abstraction
mkPoint (x,y) = p2 (x,y)
-- |Creates a Diagram that shows an XAxis which is bound
-- by the dimensions given in xD from DiagProp.
showXAxis :: Diag
showXAxis = Diag f
where
f p _ = hrule (xuD p - xlD p) # moveTo (p2(0, yOffset p))
-- |Creates a Diagram that shows an YAxis which is bound
-- by the dimensions given in yD from DiagProp.
showYAxis :: Diag
showYAxis = Diag f
where
f p _ = vrule (yuD p - ylD p) # moveTo (p2(xOffset p, 0))
-- |Creates a Diagram that shows a white rectangle which is a little
-- bit bigger as both X and Y axis dimensions from DiagProp.
showEmptyRectB :: Diag
showEmptyRectB = Diag f
where
f p _ = emptyRect (xuD p - xlD p + 50) (yuD p - ylD p + 50)
-- |Create the Diagram from the VTable.
diagFromVTable :: DiagProp -> VTable -> Diagram Cairo R2
diagFromVTable prop vt
= position (zip (map mkPoint . filter (inRange (dX prop) (dY prop)) $ vt)
(repeat dot)) # moveTo (p2(xOffset, yOffset))
`atop` hrule (xuD - xlD) # moveTo (p2(0, yOffset))
`atop` vrule (yuD - ylD) # moveTo (p2(xOffset, 0))
`atop` emptyRect (xuD - xlD + 50) (yuD - ylD + 50)
where dot = (circle $
t prop :: Diagram Cairo R2) # fc black
mkPoint (x,y) = p2 (x,y)
xlD = fst $ dX prop
xuD = snd $ dX prop
ylD = fst $ dY prop
yuD = snd $ dY prop
-- 'Diagrams' sets (0,0) to be in the middle of the
-- drawing area, so we need to shift it depending
-- on the given dimensions.
xOffset = (negate xlD / 2) - (xuD / 2)
yOffset = (negate ylD / 2) - (yuD / 2)
diag :: DiagProp -> VTable -> Diagram Cairo R2
diag p = case alg p of
0 -> mkDiag
(mconcat [showCoordinates, showXAxis, showYAxis, showEmptyRectB])
p
_ -> mempty
-- |Create the Diagram from a String which is supposed to be the contents
-- of an obj file.
diagFromString :: DiagProp -> String -> Diagram Cairo R2
diagFromString prop mesh
= diagFromVTable prop .
meshToArr $
diagS :: DiagProp -> String -> Diagram Cairo R2
diagS p mesh
= diag p .
meshToArr $
mesh