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:
parent
69026edf83
commit
8547122be6
134
Diagram.hs
134
Diagram.hs
@ -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
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user