Cleanup some compiler warnings
This commit is contained in:
@@ -1,42 +1,56 @@
|
||||
module Dodge.Render.Connectors
|
||||
( zConnect
|
||||
, zConnectCol
|
||||
, lConnect
|
||||
, lConnectMulti
|
||||
) where
|
||||
import FoldableHelp
|
||||
import Picture
|
||||
import Geometry
|
||||
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
|
||||
|
||||
module Dodge.Render.Connectors (
|
||||
zConnect,
|
||||
zConnectCol,
|
||||
lConnect,
|
||||
lConnectMulti,
|
||||
) where
|
||||
|
||||
import Control.Lens
|
||||
import FoldableHelp
|
||||
import Geometry
|
||||
import Linear.V2
|
||||
import Picture
|
||||
|
||||
zConnect :: Point2 -> Point2 -> Picture
|
||||
zConnect (V2 x y) (V2 a b) = line $ map toV2
|
||||
[(x,y)
|
||||
,(0.5 * (x+a), y)
|
||||
,(0.5 * (x+a), b)
|
||||
,(a, b)
|
||||
]
|
||||
zConnect (V2 x y) (V2 a b) =
|
||||
line $
|
||||
map
|
||||
toV2
|
||||
[ (x, y)
|
||||
, (0.5 * (x + a), y)
|
||||
, (0.5 * (x + a), b)
|
||||
, (a, b)
|
||||
]
|
||||
|
||||
zConnectCol :: Point2 -> Point2 -> Color -> Color -> Color -> Color -> Picture
|
||||
zConnectCol (V2 x y) (V2 a b) c1 c2 c3 c4 = lineCol $ zip
|
||||
( map toV2
|
||||
[(x,y)
|
||||
,(0.5 * (x+a), y)
|
||||
,(0.5 * (x+a), b)
|
||||
,(a, b)
|
||||
]
|
||||
) [c1,c2,c3,c4]
|
||||
zConnectCol (V2 x y) (V2 a b) c1 c2 c3 c4 =
|
||||
lineCol $
|
||||
zip
|
||||
( map
|
||||
toV2
|
||||
[ (x, y)
|
||||
, (0.5 * (x + a), y)
|
||||
, (0.5 * (x + a), b)
|
||||
, (a, b)
|
||||
]
|
||||
)
|
||||
[c1, c2, c3, c4]
|
||||
|
||||
lConnect :: Point2 -> Point2 -> Picture
|
||||
lConnect sp@(V2 _ y) ep@(V2 x _) = line
|
||||
[ sp
|
||||
, V2 x y
|
||||
, ep
|
||||
]
|
||||
lConnect sp@(V2 _ y) ep@(V2 x _) =
|
||||
line
|
||||
[ sp
|
||||
, V2 x y
|
||||
, ep
|
||||
]
|
||||
|
||||
-- this function is the reason for the incomplete-uni-patterns warning suppression
|
||||
lConnectMulti :: [Point2] -> Point2 -> Picture
|
||||
lConnectMulti sps (V2 x y) = line [V2 x ymin,V2 x ymax] <>
|
||||
foldMap f sps
|
||||
lConnectMulti sps (V2 x y) =
|
||||
line [V2 x ymin, V2 x ymax]
|
||||
<> foldMap f sps
|
||||
where
|
||||
(Just ymin,Just ymax) = minAndMax $ y : map (^._y) sps
|
||||
f (V2 x' y') = line [V2 x' y',V2 x y']
|
||||
(Just ymin, Just ymax) = minAndMax $ y : map (^. _y) sps
|
||||
f (V2 x' y') = line [V2 x' y', V2 x y']
|
||||
|
||||
Reference in New Issue
Block a user