hasufell/cga
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Improve readability

Browse Source
This commit is contained in:
hasufell 2014-10-25 20:39:34 +02:00
parent c4c397e12f
commit fd931db7e0
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
2 changed files with 17 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Algorithms/PolygonIntersection/Core.hs
View File

@ -53,7 +53,7 @@ sortLexPoly ps = maybe [] (`shiftM` ps) (elemIndex (yMax ps) ps)
-- while saving the origin of that point. This is done in O(n). -- while saving the origin of that point. This is done in O(n).
sortLexPolys :: ([PT], [PT]) -> [PolyPT] sortLexPolys :: ([PT], [PT]) -> [PolyPT]
sortLexPolys (pA'@(_:_), pB'@(_:_)) = sortLexPolys (pA'@(_:_), pB'@(_:_)) =
queueToList . go (Q.fromList . sortLexPoly $ pA') $ queueToList $ go (Q.fromList . sortLexPoly $ pA')
(Q.fromList . sortLexPoly $ pB') (Q.fromList . sortLexPoly $ pB')
where where
-- Start recursive algorithm, each polygon is represented by a Queue. -- Start recursive algorithm, each polygon is represented by a Queue.
@ -130,10 +130,7 @@ intersectionPoints xs' =
-- Get the scan line or in other words the -- Get the scan line or in other words the
-- Segment pairs we are going to check for intersection. -- Segment pairs we are going to check for intersection.
scanLine :: [PolyPT] -> ([Segment], [Segment]) scanLine :: [PolyPT] -> ([Segment], [Segment])
scanLine sp@(_:_) = scanLine sp@(_:_) = (,) (getSegment isPolyA) (getSegment isPolyB)
(,)
(getSegment isPolyA)
(getSegment isPolyB)
where where
getSegment f = fromMaybe [] getSegment f = fromMaybe []
((\x -> [(id' x, suc x), (id' x, pre x)]) ((\x -> [(id' x, suc x), (id' x, pre x)])
@ -144,8 +141,8 @@ intersectionPoints xs' =
-- both polygons we currently examine. This is done in O(1) -- both polygons we currently examine. This is done in O(1)
-- since we have max 4 segments. -- since we have max 4 segments.
segIntersections :: ([Segment], [Segment]) -> [PT] segIntersections :: ([Segment], [Segment]) -> [PT]
segIntersections (a@(_:_), b@(_:_)) segIntersections (a@(_:_), b@(_:_)) =
= catMaybes catMaybes
. fmap (\[x, y] -> intersectSeg' x y) . fmap (\[x, y] -> intersectSeg' x y)
$ combinations a b $ combinations a b
segIntersections _ = [] segIntersections _ = []

32
Graphics/Diagram/Gtk.hs
View File

@ -13,28 +13,19 @@ import Parser.Meshparser
diag :: DiagProp -> Object -> Diagram Cairo R2 diag :: DiagProp -> Object -> Diagram Cairo R2
diag p obj@(Object _) diag p obj@(Object _)
| alg p == 0 = | alg p == 0 =
mkDiag mkDiag (mconcat [coordPointsText, coordPoints, plotterBG])
(mconcat [coordPointsText,
coordPoints, plotterBG])
p obj p obj
| alg p == 1 = | alg p == 1 =
mkDiag mkDiag (mconcat [convexHPText, convexHP, convexHLs, coordPoints, plotterBG])
(mconcat
[convexHPText,
convexHP, convexHLs,
coordPoints, plotterBG])
p obj p obj
| otherwise = mempty | otherwise = mempty
diag p objs@(Objects _) diag p objs@(Objects _)
| alg p == 2 = | alg p == 2 =
mkDiag (mconcat [polyLines, coordPointsText, coordPoints, mkDiag (mconcat [polyLines, coordPointsText, coordPoints, plotterBG])
plotterBG])
p objs p objs
| alg p == 3 = | alg p == 3 =
mkDiag (mconcat [polyIntersectionText, mkDiag (mconcat [polyIntersectionText, polyIntersection, coordPointsText,
polyIntersection, coordPointsText, coordPoints, polyLines, plotterBG])
coordPoints, polyLines,
plotterBG])
p objs p objs
| otherwise = mempty | otherwise = mempty
@ -43,14 +34,5 @@ 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
| alg p == 2 || alg p == 3 = | alg p == 2 || alg p == 3 = diag p. Objects . facesToArr $ mesh
diag p. | otherwise = (diag p . Object . meshToArr $ mesh) # bg white
Objects .
facesToArr $
mesh
| otherwise =
(diag p .
Object .
meshToArr $
mesh) #
bg white