module Graphics.Gloss.Accelerate.Data.Point (
Point,
makePoint,
xyOfPoint,
pointOfIndex,
pointInBox,
) where
import Prelude as P
import Data.Typeable
import Data.Array.Accelerate as A
import Data.Array.Accelerate.Smart
import Data.Array.Accelerate.Tuple ( Tuple(..), TupleIdx(..), IsTuple(..), )
import Data.Array.Accelerate.Array.Sugar ( Elt(..), EltRepr, EltRepr' )
type Point = XY Float
data XY a = XY a a
deriving (Show, Eq, Typeable)
instance Num a => Num (XY a) where
(+) (XY x1 y1) (XY x2 y2) = XY (x1 + x2) (y1 + y2)
() (XY x1 y1) (XY x2 y2) = XY (x1 x2) (y1 y2)
(*) (XY x1 y1) (XY x2 y2) = XY (x1 * x2) (y1 * y2)
signum (XY x y) = XY (signum x) (signum y)
abs (XY x y) = XY (abs x) (abs y)
negate (XY x y) = XY (negate x) (negate y)
fromInteger i = let f = fromInteger i
in XY f f
type instance EltRepr (XY a) = EltRepr (a, a)
type instance EltRepr' (XY a) = EltRepr (a, a)
instance Elt a => Elt (XY a) where
eltType (_ :: XY a) = eltType (undefined :: (a,a))
toElt p = let (x,y) = toElt p in XY x y
fromElt (XY x y) = fromElt (x,y)
eltType' (_ :: XY a) = eltType' (undefined :: (a,a))
toElt' p = let (x,y) = toElt' p in XY x y
fromElt' (XY x y) = fromElt' (x,y)
instance IsTuple (XY a) where
type TupleRepr (XY a) = (((),a), a)
fromTuple (XY x y) = (((), x), y)
toTuple (((),x),y) = XY x y
instance (Lift Exp a, Elt (Plain a)) => Lift Exp (XY a) where
type Plain (XY a) = XY (Plain a)
lift (XY x y) = Exp . Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y
instance Elt a => Unlift Exp (XY (Exp a)) where
unlift p = let x = Exp $ SuccTupIdx ZeroTupIdx `Prj` p
y = Exp $ ZeroTupIdx `Prj` p
in XY x y
makePoint
:: Exp Float
-> Exp Float
-> Exp Point
makePoint x y = lift (XY x y)
xyOfPoint
:: Exp Point
-> (Exp Float, Exp Float)
xyOfPoint p
= let XY x y = unlift p
in (x, y)
pointOfIndex
:: Int
-> Int
-> Exp DIM2
-> Exp Point
pointOfIndex sizeX sizeY ix
= let
fsizeX, fsizeY :: Float
fsizeX = P.fromIntegral sizeX
fsizeY = P.fromIntegral sizeY
fsizeX2, fsizeY2 :: Exp Float
fsizeX2 = constant $ fsizeX / 2
fsizeY2 = constant $ fsizeY / 2
midX, midY :: Exp Int
midX = constant $ sizeX `div` 2
midY = constant $ sizeY `div` 2
Z :. y :. x = unlift ix
x' = A.fromIntegral (x midX) / fsizeX2
y' = A.fromIntegral (y midY) / fsizeY2
in
makePoint x' y'
pointInBox
:: Exp Point
-> Exp Point
-> Exp Point
-> Exp Bool
pointInBox p0 p1 p2
= let XY x0 y0 = unlift p0
XY x1 y1 = unlift p1
XY x2 y2 = unlift p2
in
x0 >=* min x1 x2 &&*
x0 <=* max x1 x2 &&*
y0 >=* min y1 y2 &&*
y0 <=* max y1 y2