-------------------------------------------------------------------------------
-- |
-- 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 x@(x1, y1) y@(x2, y2)
            | x == y    = [x]
            | m1Check   = bresenhamBase x y
            | otherwise = let x' = T.swap x
                              y' = T.swap y
                          in map T.swap (bresenhamBase x' y')
    where
          m1Check :: Bool
          m1Check = abs (x2 - x1) > abs (y2 - 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 (x1, y1) (x2, y2) =
        let -- first treshold
            ti = 2 * ady - adx
        in L.unfoldr f (x1, y1, ti)
           -- unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
    where
          -- slope
          dx, dy, adx, ady :: a
          dx = x2 - x1
          dy = y2 - y1
          adx = abs dx
          ady = abs dy

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

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

                        wy' | t > 0     = iy wy
                            | otherwise = wy

                        t' | t > 0     = t - 2 * adx + 2 * ady
                           | otherwise = t + 2 * ady
                    in Just ((wx, wy), (wx', wy', t'))