Draw.hs

--------------------------------------------------------------------------------
-- |
-- 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)]
-- @
--
--------------------------------------------------------------------------------

module Line.Draw (
                   Coords,
                   bresenham
                 )
        where

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

type Coords = (Int, Int)
type State  = (Int, Int, Int)
          -- curr x, curr y, treshold

-- | Rasterising a line using
-- <https://en.wikipedia.org/wiki/Bresenham%27s_line_algorithm Bresenham's algorithm>.
bresenham :: Coords -> Coords -> [Coords]
bresenham x@(x1, y1) y@(x2, y2)
            | 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 :: Coords -> Coords -> [Coords]
bresenhamBase (x1, y1) (x2, y2) =
        let -- first treshold
            ti = 2 * ady - adx
        in L.unfoldr f (x1, y1, ti)
    where
          -- slope
          dx, dy, adx, ady :: Int
          dx = x2 - x1
          dy = y2 - y1
          adx = abs dx
          ady = abs dy

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

          -- step function, takes (x, y, treshold)
          f :: State -> Maybe (Coords, State)
          f (cx, cy, t)
              | abs cx > abs x2 = Nothing
              | otherwise       =
                    let cx' = ix cx

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

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