Types.hs

{-# OPTIONS_HADDOCK prune #-}
{-# OPTIONS_HADDOCK hide #-}

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}

-- | Types for discrete geometry.

module Imj.Geo.Discrete.Types
    (
    -- * Discrete geometry types
    -- ** Direction
      Direction(..)
    -- ** Coordinates
    , Coords(..)
    , Coord(..), Col, Row
    -- ** Size
    , Size(..)
    , Length(..)
    , Width
    , Height
    , toCoords
    , maxLength
    , onOuterBorder
    , containsWithOuterBorder
    -- ** Segment
    , Segment(..)
    , mkSegment
    -- * Bresenham line algorithm
    , bresenhamLength
    , bresenham
    -- * Reexports
    , Pos, Vel
    ) where

import           Imj.Prelude

import           Imj.Geo.Discrete.Bresenham
import           Imj.Geo.Types
import           Imj.Graphics.Class.DiscreteInterpolation
import           Imj.Util

-- | Discrete directions.
data Direction = Up | Down | LEFT | RIGHT deriving (Eq, Show)

-- | Discrete coordinate.
newtype Coord a = Coord Int
  deriving (Eq, Num, Ord, Integral, Real, Enum, Show)

-- | Using bresenham 2d line algorithm.
instance DiscreteInterpolation (Coords Pos) where
  interpolate c c' i
    | c == c' = c
    | otherwise =
        let lastFrame = pred $ fromIntegral $ bresenhamLength c c'
            -- TODO measure if "head . drop (pred n)"" is more optimal than "!! n"
            index = clamp i 0 lastFrame
        in head . drop index $ bresenham $ mkSegment c c'

-- | Using bresenham 2d line algorithm.
instance DiscreteDistance (Coords Pos) where
  distance = bresenhamLength

-- | Represents a row index (y)
data Row
-- | Represents a column index (x)
data Col

-- | Two-dimensional discrete coordinates. We use phantom types 'Pos', 'Vel'
-- to distinguish positions from speeds.
data Coords a = Coords {
    _coordsY :: {-# UNPACK #-} !(Coord Row)
  , _coordsX :: {-# UNPACK #-} !(Coord Col)
} deriving (Eq, Show, Ord)

-- | Discrete length
newtype Length a = Length Int
  deriving (Eq, Num, Ord, Integral, Real, Enum, Show)

-- | Phantom type for width
data Width
-- | Phantom type for height
data Height
-- | Represents a discrete size (width and height)
data Size = Size {
    _sizeY :: {-# UNPACK #-} !(Length Height)
  , _sizeX :: {-# UNPACK #-} !(Length Width)
} deriving (Eq, Show)

-- | Width and Height to Coords
toCoords :: Length Height -> Length Width -> Coords Pos
toCoords (Length h) (Length w) =
  Coords (Coord h) (Coord w)

-- | Returns the bigger dimension (width or height)
maxLength :: Size -> Int
maxLength (Size (Length h) (Length w)) =
  max w h

-- | Tests if a 'Coords' lies on the outer border of a region of a given size,
-- containing (0,0) and positive coordinates.
onOuterBorder :: Coords Pos
              -- ^ The coordinates to test
              -> Size
              -- ^ The size
              -> Maybe Direction
              -- ^ If the coordinates are on the border, returns a 'Direction' pointing
              -- away from the region (at the given coordinates).
onOuterBorder (Coords r c) (Size rs cs)
  | r == -1 = Just Up
  | c == -1 = Just LEFT
  | r == fromIntegral rs = Just Down
  | c == fromIntegral cs = Just RIGHT
  | otherwise = Nothing

-- | Tests if a 'Coords' is contained or on the outer border of a region
-- of a given size, containing (0,0) and positive coordinates.
containsWithOuterBorder :: Coords Pos -> Size -> Bool -- TODO simplify, pass a number for the outer border size
containsWithOuterBorder (Coords r c) (Size rs cs)
  = r >= -1 && c >= -1 && r <= fromIntegral rs && c <= fromIntegral cs

-- | A segment is a line betwen two discrete coordinates.
--
-- It can be materialized as a list of 'Coords' using 'bresenham'
data Segment = Horizontal !(Coord Row) !(Coord Col) !(Coord Col)
             -- ^ Horizontal segment
             | Vertical   !(Coord Col) !(Coord Row) !(Coord Row)
             -- ^ Vertical segment
             | Oblique    !(Coords Pos) !(Coords Pos)
             -- ^ Oblique segment
             deriving(Show)

mkSegment :: Coords Pos
          -- ^ Segment start
          -> Coords Pos
          -- ^ Segment end
          -> Segment
mkSegment coord1@(Coords r1 c1) coord2@(Coords r2 c2)
  | r1 == r2  = Horizontal r1 c1 c2
  | c1 == c2  = Vertical   c1 r1 r2
  | otherwise = Oblique coord1 coord2


-- | Returns the bresenham 2d distance between two coordinates.
bresenhamLength :: Coords Pos -> Coords Pos -> Int
bresenhamLength (Coords r1 c1) (Coords r2 c2)
  = succ $ max (fromIntegral (abs (r1-r2))) $ fromIntegral (abs (c1-c2))

-- | Bresenham 2d algorithm, slightly optimized for horizontal and vertical lines.
bresenham :: Segment -> [Coords Pos]
bresenham (Horizontal r c1 c2) = map (Coords r) $ range c1 c2
bresenham (Vertical c r1 r2)   = map (flip Coords c) $ range r1 r2
bresenham (Oblique (Coords y0 x0) c2@(Coords y1 x1)) =
  takeWhileInclusive (/= c2)
  $ map (\(x,y) -> Coords (Coord y) (Coord x) )
  $ bla (fromIntegral x0,fromIntegral y0)
        (fromIntegral x1,fromIntegral y1)

takeWhileInclusive :: (a -> Bool) -> [a] -> [a]
takeWhileInclusive _ [] = []
takeWhileInclusive p (x:xs) =
  x : if p x
        then
          takeWhileInclusive p xs
        else
          []