Rework vector/point typesystem
Don't rely on Data.Vector.V2 and friend anymore, but use the types we have from Diagrams already and enhance them.
This commit is contained in:
parent
da3f71bfc0
commit
46377164b4
12
Diagram.hs
12
Diagram.hs
@ -21,7 +21,7 @@ import Parser.Meshparser
|
|||||||
-- coordinates and common properties.
|
-- coordinates and common properties.
|
||||||
data Diag = Diag {
|
data Diag = Diag {
|
||||||
mkDiag :: DiagProp
|
mkDiag :: DiagProp
|
||||||
-> VTable
|
-> [PT]
|
||||||
-> Diagram Cairo R2
|
-> Diagram Cairo R2
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -31,9 +31,9 @@ data DiagProp = MkProp {
|
|||||||
-- |The thickness of the dots.
|
-- |The thickness of the dots.
|
||||||
t :: Double,
|
t :: Double,
|
||||||
-- |The dimensions of the x-axis.
|
-- |The dimensions of the x-axis.
|
||||||
dX :: (Double, Double),
|
dX :: Coord,
|
||||||
-- |The dimensions of the y-axis.
|
-- |The dimensions of the y-axis.
|
||||||
dY :: (Double, Double),
|
dY :: Coord,
|
||||||
-- |Algorithm to use.
|
-- |Algorithm to use.
|
||||||
alg :: Int
|
alg :: Int
|
||||||
}
|
}
|
||||||
@ -95,13 +95,11 @@ showCoordinates :: Diag
|
|||||||
showCoordinates = Diag f
|
showCoordinates = Diag f
|
||||||
where
|
where
|
||||||
f p vt
|
f p vt
|
||||||
= position (zip (map mkPoint . filter (inRange (dX p) (dY p)) $ vt)
|
= position (zip (filter (inRange (dX p) (dY p)) $ vt)
|
||||||
(repeat dot)) # moveTo (p2(xOffset p, yOffset p))
|
(repeat dot)) # moveTo (p2(xOffset p, yOffset p))
|
||||||
where
|
where
|
||||||
-- a dot itself is a diagram
|
-- a dot itself is a diagram
|
||||||
dot = (circle $ t p :: Diagram Cairo R2) # fc black
|
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
|
-- |Creates a Diagram that shows an XAxis which is bound
|
||||||
@ -129,7 +127,7 @@ showWhiteRectB = Diag f
|
|||||||
|
|
||||||
|
|
||||||
-- |Create the Diagram from the VTable.
|
-- |Create the Diagram from the VTable.
|
||||||
diag :: DiagProp -> VTable -> Diagram Cairo R2
|
diag :: DiagProp -> [PT] -> Diagram Cairo R2
|
||||||
diag p = case alg p of
|
diag p = case alg p of
|
||||||
0 -> mkDiag
|
0 -> mkDiag
|
||||||
(mconcat [showCoordinates, showXAxis, showYAxis, showWhiteRectB])
|
(mconcat [showCoordinates, showXAxis, showYAxis, showWhiteRectB])
|
||||||
|
@ -2,26 +2,74 @@
|
|||||||
|
|
||||||
module LinearAlgebra.Vector where
|
module LinearAlgebra.Vector where
|
||||||
|
|
||||||
import Data.Vector.Class
|
import Diagrams.TwoD.Types
|
||||||
|
|
||||||
|
type Vec = R2
|
||||||
|
type PT = P2
|
||||||
|
type Coord = (Double, Double)
|
||||||
|
|
||||||
|
|
||||||
type Angle = Double
|
-- |Checks whether the Point is in a given dimension.
|
||||||
|
inRange :: Coord -- ^ X dimension
|
||||||
|
-> Coord -- ^ Y dimension
|
||||||
-- |Checks whether the Coordinates are in a given dimension.
|
-> PT -- ^ Coordinates
|
||||||
inRange :: (Double, Double) -- ^ X dimension
|
|
||||||
-> (Double, Double) -- ^ Y dimension
|
|
||||||
-> (Double, Double) -- ^ Coordinates
|
|
||||||
-> Bool -- ^ result
|
-> Bool -- ^ result
|
||||||
inRange (xlD, xuD) (ylD, yuD) (x,y)
|
inRange (xlD, xuD) (ylD, yuD) p
|
||||||
= x <= xuD && x >= xlD && y <= yuD && y >= ylD
|
= x <= xuD && x >= xlD && y <= yuD && y >= ylD
|
||||||
|
where
|
||||||
|
(x, y) = unp2 p
|
||||||
|
|
||||||
|
|
||||||
-- |Get the angle between two vectors in degrees.
|
-- |Get the angle between two vectors in degrees.
|
||||||
getAngle :: (Vector v) => v -> v -> Angle
|
getAngle :: Vec -> Vec -> Double
|
||||||
getAngle a b = (*) 180.0 .
|
getAngle a b = acos .
|
||||||
flip (/) pi .
|
flip (/) (vecLength a * vecLength b) .
|
||||||
acos .
|
scalarProd a $
|
||||||
flip (/) (vmag a * vmag b) .
|
|
||||||
vdot a $
|
|
||||||
b
|
b
|
||||||
|
|
||||||
|
|
||||||
|
-- |Get the length of a vector.
|
||||||
|
vecLength :: Vec -> Double
|
||||||
|
vecLength v = sqrt (x^2 + y^2)
|
||||||
|
where
|
||||||
|
(x, y) = unr2 v
|
||||||
|
|
||||||
|
|
||||||
|
-- |Compute the scalar product of two vectors.
|
||||||
|
scalarProd :: Vec -> Vec -> Double
|
||||||
|
scalarProd v1 v2 = a1 * b1 + a2 * b2
|
||||||
|
where
|
||||||
|
(a1, a2) = unr2 v1
|
||||||
|
(b1, b2) = unr2 v2
|
||||||
|
|
||||||
|
|
||||||
|
-- |Construct a vector that points to a point from the origin.
|
||||||
|
pt2Vec :: PT -> Vec
|
||||||
|
pt2Vec = r2 . unp2
|
||||||
|
|
||||||
|
|
||||||
|
-- |Give the point which is at the coordinates the vector
|
||||||
|
-- points to from the origin.
|
||||||
|
vec2Pt :: Vec -> PT
|
||||||
|
vec2Pt = p2 . unr2
|
||||||
|
|
||||||
|
|
||||||
|
-- |Construct a vector between two points.
|
||||||
|
vp2 :: PT -- ^ vector origin
|
||||||
|
-> PT -- ^ vector points here
|
||||||
|
-> Vec
|
||||||
|
vp2 a b = (pt2Vec b) - (pt2Vec a)
|
||||||
|
|
||||||
|
|
||||||
|
-- |Checks if 3 points a,b,c build a counterclock wise triangle by
|
||||||
|
-- connecting a-b-c. This is done by computing thed determinant and
|
||||||
|
-- checking the algebraic sign.
|
||||||
|
ccw :: PT -> PT -> PT -> Bool
|
||||||
|
ccw a b c = (bx - ax) *
|
||||||
|
(cy - ay) -
|
||||||
|
(by - ay) *
|
||||||
|
(cx - ax) >= 0
|
||||||
|
where
|
||||||
|
(ax, ay) = unp2 a
|
||||||
|
(bx, by) = unp2 b
|
||||||
|
(cx, cy) = unp2 c
|
||||||
|
@ -1,23 +1,25 @@
|
|||||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||||
|
|
||||||
module Parser.Meshparser (VTable, meshToArr) where
|
module Parser.Meshparser (meshToArr) where
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
|
import Diagrams.TwoD.Types
|
||||||
|
import LinearAlgebra.Vector
|
||||||
import Parser.Core
|
import Parser.Core
|
||||||
|
|
||||||
-- |The VTable is represented by a 'Double' tuple, 2-dimensional.
|
|
||||||
type VTable = [(Double, Double)]
|
|
||||||
|
|
||||||
-- | Convert a text String with multiple vertices into
|
-- | Convert a text String with multiple vertices into
|
||||||
-- an array of float tuples.
|
-- an array of float tuples.
|
||||||
meshToArr :: String -- ^ the string to convert
|
meshToArr :: String -- ^ the string to convert
|
||||||
-> VTable -- ^ the resulting vertice table
|
-> [PT] -- ^ the resulting vertice table
|
||||||
meshToArr xs = fmap (\(Just (x, _)) -> x) .
|
meshToArr xs = fmap (p2) .
|
||||||
|
fmap (\(Just (x, _)) -> x) .
|
||||||
filter (/= Nothing) .
|
filter (/= Nothing) .
|
||||||
fmap (runParser parseVertice) .
|
fmap (runParser parseVertice) .
|
||||||
lines $
|
lines $
|
||||||
xs
|
xs
|
||||||
|
|
||||||
|
|
||||||
-- | Creates a Parser that accepts a single vertice, such as 'v 1.0 2.0'.
|
-- | Creates a Parser that accepts a single vertice, such as 'v 1.0 2.0'.
|
||||||
parseVertice :: Parser (Double, Double)
|
parseVertice :: Parser (Double, Double)
|
||||||
parseVertice = (,) <$>
|
parseVertice = (,) <$>
|
||||||
|
Loading…
Reference in New Issue
Block a user