From 9b8d3185fe6cee9231ed20a1dbf0240d0c459a39 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 3 Jul 2020 20:32:36 -0400 Subject: refactor(xan): Switch to V2 over tuples most places These are generally rather nicer to work due to some typeclass instances, and integrate better with other ecosystems for things like linear algebra etc. Change-Id: I546c8da7b17234648f3d612b28741c1fded25447 Reviewed-on: https://cl.tvl.fyi/c/depot/+/910 Tested-by: BuildkiteCI Reviewed-by: glittershark --- .../xanthous/src/Xanthous/Util/Graphics.hs | 84 +++++++++++----------- 1 file changed, 43 insertions(+), 41 deletions(-) (limited to 'users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs') diff --git a/users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs b/users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs index 1b8b79164397..353fcfc59b14 100644 --- a/users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs +++ b/users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs @@ -38,18 +38,22 @@ import Linear.V2 -- -- Code taken from circle :: (Num i, Ord i) - => (i, i) -- ^ center - -> i -- ^ radius - -> [(i, i)] -circle (x₀, y₀) radius + => V2 i -- ^ center + -> i -- ^ radius + -> [V2 i] +circle (V2 x₀ y₀) radius -- Four initial points, plus the generated points - = (x₀, y₀ + radius) : (x₀, y₀ - radius) : (x₀ + radius, y₀) : (x₀ - radius, y₀) : points + = V2 x₀ (y₀ + radius) + : V2 x₀ (y₀ - radius) + : V2 (x₀ + radius) y₀ + : V2 (x₀ - radius) y₀ + : points where -- Creates the (x, y) octet offsets, then maps them to absolute points in all octets. points = concatMap generatePoints $ unfoldr step initialValues - generatePoints (x, y) - = [ (x₀ `xop` x', y₀ `yop` y') + generatePoints (V2 x y) + = [ V2 (x₀ `xop` x') (y₀ `yop` y') | (x', y') <- [(x, y), (y, x)] , xop <- [(+), (-)] , yop <- [(+), (-)] @@ -59,7 +63,7 @@ circle (x₀, y₀) radius step (f, ddf_x, ddf_y, x, y) | x >= y = Nothing - | otherwise = Just ((x', y'), (f', ddf_x', ddf_y', x', y')) + | otherwise = Just (V2 x' y', (f', ddf_x', ddf_y', x', y')) where (f', ddf_y', y') | f >= 0 = (f + ddf_y' + ddf_x', ddf_y + 2, y - 1) | otherwise = (f + ddf_x, ddf_y, y) @@ -70,11 +74,11 @@ circle (x₀, y₀) radius data FillState i = FillState { _inCircle :: Bool - , _result :: NonEmpty (i, i) + , _result :: NonEmpty (V2 i) } makeLenses ''FillState -runFillState :: NonEmpty (i, i) -> State (FillState i) a -> [(i, i)] +runFillState :: NonEmpty (V2 i) -> State (FillState i) a -> [V2 i] runFillState circumference s = toList . view result @@ -84,11 +88,11 @@ runFillState circumference s -- | Generate a *filled* circle centered at the given point and with the given -- radius by filling a circle generated with 'circle' filledCircle :: (Num i, Integral i, Ix i) - => (i, i) -- ^ center - -> i -- ^ radius - -> [(i, i)] -filledCircle origin radius = - case NE.nonEmpty (circle origin radius) of + => V2 i -- ^ center + -> i -- ^ radius + -> [V2 i] +filledCircle center radius = + case NE.nonEmpty (circle center radius) of Nothing -> [] Just circumference -> runFillState circumference $ -- the first and last lines of all circles are solid, so the whole "in the @@ -96,44 +100,44 @@ filledCircle origin radius = -- we don't need to fill them. So just skip them for_ [succ minX..pred maxX] $ \x -> for_ [minY..maxY] $ \y -> do - let pt = (x, y) - next = (x, succ y) + let pt = V2 x y + next = V2 x $ succ y whenM (use inCircle) $ result %= NE.cons pt when (pt `elem` circumference && next `notElem` circumference) $ inCircle %= not where - ((minX, minY), (maxX, maxY)) = minmaxes circumference + (V2 minX minY, V2 maxX maxY) = minmaxes circumference -- | Draw a line between two points using Bresenham's line drawing algorithm -- -- Code taken from -line :: (Num i, Ord i) => (i, i) -> (i, i) -> [(i, i)] -line pa@(xa, ya) pb@(xb, yb) +line :: (Num i, Ord i) => V2 i -> V2 i -> [V2 i] +line pa@(V2 xa ya) pb@(V2 xb yb) = (if maySwitch pa < maySwitch pb then id else reverse) points where points = map maySwitch . unfoldr go $ (x₁, y₁, 0) steep = abs (yb - ya) > abs (xb - xa) - maySwitch = if steep then swap else id - [(x₁, y₁), (x₂, y₂)] = sort [maySwitch pa, maySwitch pb] + maySwitch = if steep then view _yx else id + [V2 x₁ y₁, V2 x₂ y₂] = sort [maySwitch pa, maySwitch pb] δx = x₂ - x₁ δy = abs (y₂ - y₁) ystep = if y₁ < y₂ then 1 else -1 go (xTemp, yTemp, err) | xTemp > x₂ = Nothing - | otherwise = Just ((xTemp, yTemp), (xTemp + 1, newY, newError)) + | otherwise = Just ((V2 xTemp yTemp), (xTemp + 1, newY, newError)) where tempError = err + δy (newY, newError) = if (2 * tempError) >= δx then (yTemp + ystep, tempError - δx) else (yTemp, tempError) -{-# SPECIALIZE line :: (Int, Int) -> (Int, Int) -> [(Int, Int)] #-} -{-# SPECIALIZE line :: (Word, Word) -> (Word, Word) -> [(Word, Word)] #-} +{-# SPECIALIZE line :: V2 Int -> V2 Int -> [V2 Int] #-} +{-# SPECIALIZE line :: V2 Word -> V2 Word -> [V2 Word] #-} -straightLine :: (Num i, Ord i) => (i, i) -> (i, i) -> [(i, i)] -straightLine pa@(xa, _) pb@(_, yb) = line pa midpoint ++ line midpoint pb - where midpoint = (xa, yb) +straightLine :: (Num i, Ord i) => V2 i -> V2 i -> [V2 i] +straightLine pa@(V2 xa _) pb@(V2 _ yb) = line pa midpoint ++ line midpoint pb + where midpoint = V2 xa yb delaunay @@ -151,26 +155,24 @@ delaunay -------------------------------------------------------------------------------- -renderBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [(i, i)] -> String +renderBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [V2 i] -> String renderBooleanGraphics [] = "" renderBooleanGraphics (pt : pts') = intercalate "\n" rows where rows = row <$> [minX..maxX] - row x = [minY..maxY] <&> \y -> if (x, y) `member` ptSet then 'X' else ' ' - ((minX, minY), (maxX, maxY)) = minmaxes pts + row x = [minY..maxY] <&> \y -> if V2 x y `member` ptSet then 'X' else ' ' + (V2 minX minY, V2 maxX maxY) = minmaxes pts pts = pt :| pts' - ptSet :: Set (i, i) + ptSet :: Set (V2 i) ptSet = setFromList $ toList pts -showBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [(i, i)] -> IO () +showBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [V2 i] -> IO () showBooleanGraphics = putStrLn . pack . renderBooleanGraphics -minmaxes :: forall i. (Ord i) => NonEmpty (i, i) -> ((i, i), (i, i)) +minmaxes :: forall i. (Ord i) => NonEmpty (V2 i) -> (V2 i, V2 i) minmaxes xs = - ( ( minimum1Of (traverse1 . _1) xs - , minimum1Of (traverse1 . _2) xs - ) - , ( maximum1Of (traverse1 . _1) xs - , maximum1Of (traverse1 . _2) xs - ) - ) + ( V2 (minimum1Of (traverse1 . _x) xs) + (minimum1Of (traverse1 . _y) xs) + , V2 (maximum1Of (traverse1 . _x) xs) + (maximum1Of (traverse1 . _y) xs) + ) -- cgit 1.4.1