53 lines
1.4 KiB
Haskell
53 lines
1.4 KiB
Haskell
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
|
|
|
|
module Dodge.Render.Connectors (
|
|
zConnect,
|
|
zConnectCol,
|
|
zConnectColMidX,
|
|
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)
|
|
]
|
|
|
|
zConnectCol :: Point2 -> Point2 -> Color -> Color -> Color -> Color -> Picture
|
|
zConnectCol (V2 x y) (V2 a b) = zConnectColMidX (V2 x y) (V2 a b) (0.5 * (x + a))
|
|
|
|
zConnectColMidX :: Point2 -> Point2 -> Float -> Color -> Color -> Color -> Color -> Picture
|
|
zConnectColMidX (V2 x y) (V2 a b) midx c1 c2 c3 c4 =
|
|
lineCol $
|
|
zip
|
|
[ V2 x y
|
|
, V2 midx y
|
|
, V2 midx b
|
|
, V2 a b
|
|
]
|
|
[c1, c2, c3, c4]
|
|
|
|
lConnect :: Point2 -> Point2 -> Picture
|
|
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
|
|
where
|
|
(Just ymin, Just ymax) = minAndMax $ y : map (^. _y) sps
|
|
f (V2 x' y') = line [V2 x' y', V2 x y']
|