DIAG: filter valid points earlier
This saves us some code duplication.
This commit is contained in:
parent
8c1d54d97a
commit
562fdbe26f
@ -34,4 +34,4 @@ gifDiag p xs =
|
|||||||
-- |Same as gifDiag, except that it takes a string containing the
|
-- |Same as gifDiag, except that it takes a string containing the
|
||||||
-- mesh file content instead of the the points.
|
-- mesh file content instead of the the points.
|
||||||
gifDiagS :: DiagProp -> MeshString -> [(Diagram Cairo R2, GifDelay)]
|
gifDiagS :: DiagProp -> MeshString -> [(Diagram Cairo R2, GifDelay)]
|
||||||
gifDiagS p = gifDiag p . meshToArr
|
gifDiagS p = gifDiag p . filterValidPT p . meshToArr
|
||||||
|
@ -38,13 +38,21 @@ diag p objs@(Objects _)
|
|||||||
-- of an obj file.
|
-- of an obj file.
|
||||||
diagS :: DiagProp -> MeshString -> Diagram Cairo R2
|
diagS :: DiagProp -> MeshString -> Diagram Cairo R2
|
||||||
diagS p mesh
|
diagS p mesh
|
||||||
| algo p == 2 || algo p == 3 = diag p. Objects . facesToArr $ mesh
|
| algo p == 2 || algo p == 3 =
|
||||||
| otherwise = (diag p . Object . meshToArr $ mesh) # bg white
|
diag p
|
||||||
|
. Objects
|
||||||
|
. fmap (filterValidPT p)
|
||||||
|
. facesToArr
|
||||||
|
$ mesh
|
||||||
|
| otherwise = (diag p . Object . filterValidPT p . meshToArr $ mesh) # bg white
|
||||||
|
|
||||||
|
|
||||||
-- |Create the tree diagram from a String which is supposed to be the contents
|
-- |Create the tree diagram from a String which is supposed to be the contents
|
||||||
-- of an obj file.
|
-- of an obj file.
|
||||||
diagTreeS :: DiagProp -> MeshString -> Diagram Cairo R2
|
diagTreeS :: DiagProp -> MeshString -> Diagram Cairo R2
|
||||||
diagTreeS p mesh
|
diagTreeS p mesh
|
||||||
| algo p == 4 = mkDiag treePretty p (Object . meshToArr $mesh)
|
| algo p == 4 = mkDiag treePretty p (Object
|
||||||
|
. filterValidPT p
|
||||||
|
. meshToArr
|
||||||
|
$ mesh)
|
||||||
| otherwise = mempty
|
| otherwise = mempty
|
||||||
|
@ -26,8 +26,7 @@ coordPoints = Diag cp
|
|||||||
cp p (Objects vts) = drawP (concat vts) p
|
cp p (Objects vts) = drawP (concat vts) p
|
||||||
drawP [] _ = mempty
|
drawP [] _ = mempty
|
||||||
drawP vt p =
|
drawP vt p =
|
||||||
position (zip (filterValidPT p vt)
|
position (zip vt (repeat dot))
|
||||||
(repeat dot))
|
|
||||||
where
|
where
|
||||||
dot = (circle $ dotSize p :: Diagram Cairo R2) # fc black
|
dot = (circle $ dotSize p :: Diagram Cairo R2) # fc black
|
||||||
|
|
||||||
@ -54,11 +53,9 @@ coordPointsText = Diag cpt
|
|||||||
drawT vt p
|
drawT vt p
|
||||||
| showCoordText p =
|
| showCoordText p =
|
||||||
position
|
position
|
||||||
$ zip vtf (pointToTextCoord <$> vtf)
|
$ zip vt (pointToTextCoord <$> vt)
|
||||||
# translate (r2 (0, 10))
|
# translate (r2 (0, 10))
|
||||||
| otherwise = mempty
|
| otherwise = mempty
|
||||||
where
|
|
||||||
vtf = filterValidPT p vt
|
|
||||||
|
|
||||||
|
|
||||||
-- |Draw the lines of the polygon.
|
-- |Draw the lines of the polygon.
|
||||||
@ -66,15 +63,14 @@ polyLines :: Diag
|
|||||||
polyLines = Diag pp
|
polyLines = Diag pp
|
||||||
where
|
where
|
||||||
pp _ (Objects []) = mempty
|
pp _ (Objects []) = mempty
|
||||||
pp p (Objects (x:y:_)) =
|
pp _ (Objects (x:y:_)) =
|
||||||
strokePoly x <> strokePoly y
|
strokePoly x <> strokePoly y
|
||||||
where
|
where
|
||||||
strokePoly x' =
|
strokePoly x' =
|
||||||
(strokeTrail
|
(strokeTrail
|
||||||
. fromVertices
|
. fromVertices
|
||||||
$ vtf x' ++ [head . vtf $ x'])
|
$ x' ++ [head x'])
|
||||||
# moveTo (head x') # lc black
|
# moveTo (head x') # lc black
|
||||||
vtf = filterValidPT p
|
|
||||||
pp _ _ = mempty
|
pp _ _ = mempty
|
||||||
|
|
||||||
|
|
||||||
@ -87,8 +83,8 @@ polyIntersection = Diag pi'
|
|||||||
dot = (circle $ dotSize p :: Diagram Cairo R2) # fc red # lc red
|
dot = (circle $ dotSize p :: Diagram Cairo R2) # fc red # lc red
|
||||||
vtpi = intersectionPoints
|
vtpi = intersectionPoints
|
||||||
. sortLexPolys
|
. sortLexPolys
|
||||||
$ (sortLexPoly . filterValidPT p $ x,
|
$ (sortLexPoly x,
|
||||||
sortLexPoly . filterValidPT p $ y)
|
sortLexPoly y)
|
||||||
pi' _ _ = mempty
|
pi' _ _ = mempty
|
||||||
|
|
||||||
|
|
||||||
@ -106,8 +102,8 @@ polyIntersectionText = Diag pit'
|
|||||||
where
|
where
|
||||||
vtpi = intersectionPoints
|
vtpi = intersectionPoints
|
||||||
. sortLexPolys
|
. sortLexPolys
|
||||||
$ (sortLexPoly . filterValidPT p $ x,
|
$ (sortLexPoly x,
|
||||||
sortLexPoly . filterValidPT p $ y)
|
sortLexPoly y)
|
||||||
pit' _ _ = mempty
|
pit' _ _ = mempty
|
||||||
|
|
||||||
|
|
||||||
@ -120,7 +116,7 @@ convexHP = Diag chp
|
|||||||
(repeat dot))
|
(repeat dot))
|
||||||
where
|
where
|
||||||
dot = (circle $ dotSize p :: Diagram Cairo R2) # fc red # lc red
|
dot = (circle $ dotSize p :: Diagram Cairo R2) # fc red # lc red
|
||||||
vtch = grahamCH $ filterValidPT p vt
|
vtch = grahamCH vt
|
||||||
chp _ _ = mempty
|
chp _ _ = mempty
|
||||||
|
|
||||||
|
|
||||||
@ -135,7 +131,7 @@ convexHPText = Diag chpt
|
|||||||
(pointToTextCoord <$> vtchf) # translate (r2 (0, 10))
|
(pointToTextCoord <$> vtchf) # translate (r2 (0, 10))
|
||||||
| otherwise = mempty
|
| otherwise = mempty
|
||||||
where
|
where
|
||||||
vtchf = grahamCH . filterValidPT p $ vt
|
vtchf = grahamCH vt
|
||||||
chpt _ _ = mempty
|
chpt _ _ = mempty
|
||||||
|
|
||||||
|
|
||||||
@ -145,15 +141,13 @@ convexHLs :: Diag
|
|||||||
convexHLs = Diag chl
|
convexHLs = Diag chl
|
||||||
where
|
where
|
||||||
chl _ (Object []) = mempty
|
chl _ (Object []) = mempty
|
||||||
chl p (Object vt) =
|
chl _ (Object vt) =
|
||||||
(strokeTrail
|
(strokeTrail
|
||||||
. fromVertices
|
. fromVertices
|
||||||
. flip (++) [head $ grahamCH vtf]
|
. flip (++) [head $ grahamCH vt]
|
||||||
. grahamCH
|
. grahamCH
|
||||||
$ vtf)
|
$ vt)
|
||||||
# moveTo (head $ grahamCH vtf) # lc red
|
# moveTo (head $ grahamCH vt) # lc red
|
||||||
where
|
|
||||||
vtf = filterValidPT p vt
|
|
||||||
chl _ _ = mempty
|
chl _ _ = mempty
|
||||||
|
|
||||||
|
|
||||||
@ -164,7 +158,7 @@ convexHStepsLs :: Diag
|
|||||||
convexHStepsLs = GifDiag chs
|
convexHStepsLs = GifDiag chs
|
||||||
where
|
where
|
||||||
chs p col f vt =
|
chs p col f vt =
|
||||||
fmap mkChDiag (f . filterValidPT p $ vt)
|
fmap mkChDiag (f vt)
|
||||||
where
|
where
|
||||||
mkChDiag vt' =
|
mkChDiag vt' =
|
||||||
(strokeTrail . fromVertices $ vt') # moveTo (head vt') # lc col
|
(strokeTrail . fromVertices $ vt') # moveTo (head vt') # lc col
|
||||||
@ -181,17 +175,15 @@ squares = Diag f
|
|||||||
$ (\((xmin, xmax), (ymin, ymax)) -> rect (xmax - xmin) (ymax - ymin)
|
$ (\((xmin, xmax), (ymin, ymax)) -> rect (xmax - xmin) (ymax - ymin)
|
||||||
# moveTo (p2 ((xmax + xmin) / 2, (ymax + ymin) / 2)) # lw ultraThin)
|
# moveTo (p2 ((xmax + xmin) / 2, (ymax + ymin) / 2)) # lw ultraThin)
|
||||||
<$> (quadTreeSquares (xDimension p, yDimension p)
|
<$> (quadTreeSquares (xDimension p, yDimension p)
|
||||||
. quadTree vtf
|
. quadTree vt
|
||||||
$ (xDimension p, yDimension p))
|
$ (xDimension p, yDimension p))
|
||||||
where
|
|
||||||
vtf = filterValidPT p vt
|
|
||||||
f _ _ = mempty
|
f _ _ = mempty
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- |Get the quad tree corresponding to the given points and diagram properties.
|
-- |Get the quad tree corresponding to the given points and diagram properties.
|
||||||
qt :: [PT] -> DiagProp -> QuadTree PT
|
qt :: [PT] -> DiagProp -> QuadTree PT
|
||||||
qt vt p = quadTree (filterValidPT p vt) (xDimension p, yDimension p)
|
qt vt p = quadTree vt (xDimension p, yDimension p)
|
||||||
|
|
||||||
|
|
||||||
-- |Create a diagram that shows a single square of the RangeSearch algorithm
|
-- |Create a diagram that shows a single square of the RangeSearch algorithm
|
||||||
|
Loading…
Reference in New Issue
Block a user