-------------------------------------------------------------------------------
-- |
-- Module      :  Line.Draw
-- Copyright   :  (C) 2019 Francesco Ariis
-- License     :  BSD3 (see LICENSE file)
--
-- Maintainer  :  Francesco Ariis <fa-ml@ariis.it>
-- Stability   :  provisional
-- Portability :  portable
--
-- Rasterisation of line segments on discrete graphical media
-- (<https://en.wikipedia.org/wiki/Line_drawing_algorithm line drawing algorithm>).
--
-- Example:
--
-- @
-- λ> bresenham (0, 0) (4, 2)
-- [(0,0), (1,0), (2,1), (3,1), (4,2)]
-- @
--
-------------------------------------------------------------------------------

{-# Language ScopedTypeVariables #-}

module Line.Draw ( bresenham )
        where

import qualified Data.List  as L
import qualified Data.Tuple as T


-- | Rasterising a line using
-- <https://en.wikipedia.org/wiki/Bresenham%27s_line_algorithm Bresenham's algorithm>.
bresenham :: Integral a => (a, a) -> (a, a) -> [(a, a)]
bresenham :: forall a. Integral a => (a, a) -> (a, a) -> [(a, a)]
bresenham x :: (a, a)
x@(a
x1, a
y1) y :: (a, a)
y@(a
x2, a
y2)
            | (a, a)
x forall a. Eq a => a -> a -> Bool
== (a, a)
y    = [(a, a)
x]
            | Bool
m1Check   = forall a. Integral a => (a, a) -> (a, a) -> [(a, a)]
bresenhamBase (a, a)
x (a, a)
y
            | Bool
otherwise = let x' :: (a, a)
x' = forall a b. (a, b) -> (b, a)
T.swap (a, a)
x
                              y' :: (a, a)
y' = forall a b. (a, b) -> (b, a)
T.swap (a, a)
y
                          in forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
T.swap (forall a. Integral a => (a, a) -> (a, a) -> [(a, a)]
bresenhamBase (a, a)
x' (a, a)
y')
    where
          m1Check :: Bool
          m1Check :: Bool
m1Check = forall a. Num a => a -> a
abs (a
x2 forall a. Num a => a -> a -> a
- a
x1) forall a. Ord a => a -> a -> Bool
> forall a. Num a => a -> a
abs (a
y2 forall a. Num a => a -> a -> a
- a
y1)


-----------------
-- ANCILLARIES --
-----------------

-- bresenhamBase is only valid when y-distance is greater than x-one
bresenhamBase :: forall a . Integral a => (a, a) -> (a, a) -> [(a, a)]
bresenhamBase :: forall a. Integral a => (a, a) -> (a, a) -> [(a, a)]
bresenhamBase (a
x1, a
y1) (a
x2, a
y2) =
        let -- first treshold
            ti :: a
ti = a
2 forall a. Num a => a -> a -> a
* a
ady forall a. Num a => a -> a -> a
- a
adx
        in forall b a. (b -> Maybe (a, b)) -> b -> [a]
L.unfoldr (a, a, a) -> Maybe ((a, a), (a, a, a))
f (a
x1, a
y1, a
ti)
           -- unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
    where
          -- slope
          dx, dy, adx, ady :: a
          dx :: a
dx = a
x2 forall a. Num a => a -> a -> a
- a
x1
          dy :: a
dy = a
y2 forall a. Num a => a -> a -> a
- a
y1
          adx :: a
adx = forall a. Num a => a -> a
abs a
dx
          ady :: a
ady = forall a. Num a => a -> a
abs a
dy

          -- sign of increment
          ix, iy :: a -> a
          ix :: a -> a
ix | a
dx forall a. Ord a => a -> a -> Bool
> a
0    = (forall a. Num a => a -> a -> a
+a
1)
             | Bool
otherwise = forall a. Num a => a -> a -> a
subtract a
1
          iy :: a -> a
iy | a
dy forall a. Ord a => a -> a -> Bool
> a
0    = (forall a. Num a => a -> a -> a
+a
1)
             | Bool
otherwise = forall a. Num a => a -> a -> a
subtract a
1

          -- step function, takes (x, y, treshold)
                -- curr x, curr y, treshold
          f :: (a, a, a) -> Maybe ((a, a), (a, a, a))
          f :: (a, a, a) -> Maybe ((a, a), (a, a, a))
f (a
wx, a
wy, a
t)
                    -- pos dx and neg dx have different reach conditions
                    -- can't use abs wx > abs x2
              | a
dx forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&&
                a
wx forall a. Ord a => a -> a -> Bool
> a
x2         = forall a. Maybe a
Nothing
              | a
dx forall a. Ord a => a -> a -> Bool
<  a
0 Bool -> Bool -> Bool
&&
                a
wx forall a. Ord a => a -> a -> Bool
< a
x2         = forall a. Maybe a
Nothing
              | Bool
otherwise       =
                    let wx' :: a
wx' = a -> a
ix a
wx

                        wy' :: a
wy' | a
t forall a. Ord a => a -> a -> Bool
> a
0     = a -> a
iy a
wy
                            | Bool
otherwise = a
wy

                        t' :: a
t' | a
t forall a. Ord a => a -> a -> Bool
> a
0     = a
t forall a. Num a => a -> a -> a
- a
2 forall a. Num a => a -> a -> a
* a
adx forall a. Num a => a -> a -> a
+ a
2 forall a. Num a => a -> a -> a
* a
ady
                           | Bool
otherwise = a
t forall a. Num a => a -> a -> a
+ a
2 forall a. Num a => a -> a -> a
* a
ady
                    in forall a. a -> Maybe a
Just ((a
wx, a
wy), (a
wx', a
wy', a
t'))