{-# OPTIONS_HADDOCK prune #-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
module Imj.Geo.Discrete.Types
(
Direction(..)
, Coords(..)
, Coord(..), Col, Row
, Size(..)
, Length(..)
, Width
, Height
, toCoords
, maxLength
, onOuterBorder
, containsWithOuterBorder
, Segment(..)
, mkSegment
, bresenhamLength
, bresenham
, Pos, Vel
) where
import Imj.Prelude
import Imj.Geo.Discrete.Bresenham
import Imj.Geo.Types
import Imj.Graphics.Class.DiscreteInterpolation
import Imj.Util
data Direction = Up | Down | LEFT | RIGHT deriving (Eq, Show)
newtype Coord a = Coord Int
deriving (Eq, Num, Ord, Integral, Real, Enum, Show)
instance DiscreteInterpolation (Coords Pos) where
interpolate c c' i
| c == c' = c
| otherwise =
let lastFrame = pred $ fromIntegral $ bresenhamLength c c'
index = clamp i 0 lastFrame
in head . drop index $ bresenham $ mkSegment c c'
instance DiscreteDistance (Coords Pos) where
distance = bresenhamLength
data Row
data Col
data Coords a = Coords {
_coordsY :: {-# UNPACK #-} !(Coord Row)
, _coordsX :: {-# UNPACK #-} !(Coord Col)
} deriving (Eq, Show, Ord)
newtype Length a = Length Int
deriving (Eq, Num, Ord, Integral, Real, Enum, Show)
data Width
data Height
data Size = Size {
_sizeY :: {-# UNPACK #-} !(Length Height)
, _sizeX :: {-# UNPACK #-} !(Length Width)
} deriving (Eq, Show)
toCoords :: Length Height -> Length Width -> Coords Pos
toCoords (Length h) (Length w) =
Coords (Coord h) (Coord w)
maxLength :: Size -> Int
maxLength (Size (Length h) (Length w)) =
max w h
onOuterBorder :: Coords Pos
-> Size
-> Maybe Direction
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
containsWithOuterBorder :: Coords Pos -> Size -> Bool
containsWithOuterBorder (Coords r c) (Size rs cs)
= r >= -1 && c >= -1 && r <= fromIntegral rs && c <= fromIntegral cs
data Segment = Horizontal !(Coord Row) !(Coord Col) !(Coord Col)
| Vertical !(Coord Col) !(Coord Row) !(Coord Row)
| Oblique !(Coords Pos) !(Coords Pos)
deriving(Show)
mkSegment :: Coords Pos
-> Coords Pos
-> 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
bresenhamLength :: Coords Pos -> Coords Pos -> Int
bresenhamLength (Coords r1 c1) (Coords r2 c2)
= succ $ max (fromIntegral (abs (r1-r2))) $ fromIntegral (abs (c1-c2))
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
[]