--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Render
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
-- Description :  Some rendering functions for rendering (drawing) geometric objects
--
--------------------------------------------------------------------------------
module Graphics.Render where

import Data.Ext
import Control.Lens
import Data.Geometry.Point
import Data.Geometry.Triangle
import Data.Geometry.LineSegment
import Data.Geometry.Transformation
import Data.Geometry.Properties

--------------------------------------------------------------------------------
-- * Rendering functions

-- | Rendering function for a triangle.
--
renderTriangle :: Fractional r => Transformation 3 r -> Triangle 3 p r -> Triangle 2 p r
renderTriangle :: Transformation 3 r -> Triangle 3 p r -> Triangle 2 p r
renderTriangle = (Triangle 3 p r -> Triangle 2 p r)
-> Transformation 3 r -> Triangle 3 p r -> Triangle 2 p r
forall r g g'.
(Fractional r, IsTransformable g, Dimension g ~ 3,
 NumType g ~ r) =>
(g -> g') -> Transformation 3 r -> g -> g'
renderWithTransform Triangle 3 p r -> Triangle 2 p r
forall (d :: Nat) (d :: Nat) extra r.
(ImplicitPeano (Peano d), ImplicitPeano (Peano d),
 ArityPeano (Peano (FromPeano (Peano d))),
 ArityPeano (Peano (FromPeano (Peano d))), KnownNat d,
 KnownNat (FromPeano (Peano d)), KnownNat (FromPeano (Peano d)),
 KnownNat d,
 Peano (FromPeano (Peano d) + 1) ~ 'S (Peano (FromPeano (Peano d))),
 (d <=? d) ~ 'True,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
Triangle d extra r -> Triangle d extra r
projectTriangle
  where
    projectTriangle :: Triangle d extra r -> Triangle d extra r
projectTriangle (Triangle Point d r :+ extra
p Point d r :+ extra
q Point d r :+ extra
r) = (Point d r :+ extra)
-> (Point d r :+ extra)
-> (Point d r :+ extra)
-> Triangle d extra r
forall (d :: Nat) p r.
(Point d r :+ p)
-> (Point d r :+ p) -> (Point d r :+ p) -> Triangle d p r
Triangle (Point d r :+ extra
p(Point d r :+ extra)
-> ((Point d r :+ extra) -> Point d r :+ extra)
-> Point d r :+ extra
forall a b. a -> (a -> b) -> b
&(Point d r -> Identity (Point d r))
-> (Point d r :+ extra) -> Identity (Point d r :+ extra)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point d r -> Identity (Point d r))
 -> (Point d r :+ extra) -> Identity (Point d r :+ extra))
-> (Point d r -> Point d r)
-> (Point d r :+ extra)
-> Point d r :+ extra
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point d r -> Point d r
forall (i :: Nat) (d :: Nat) r.
(Arity i, Arity d, i <= d) =>
Point d r -> Point i r
projectPoint)
                                                (Point d r :+ extra
q(Point d r :+ extra)
-> ((Point d r :+ extra) -> Point d r :+ extra)
-> Point d r :+ extra
forall a b. a -> (a -> b) -> b
&(Point d r -> Identity (Point d r))
-> (Point d r :+ extra) -> Identity (Point d r :+ extra)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point d r -> Identity (Point d r))
 -> (Point d r :+ extra) -> Identity (Point d r :+ extra))
-> (Point d r -> Point d r)
-> (Point d r :+ extra)
-> Point d r :+ extra
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point d r -> Point d r
forall (i :: Nat) (d :: Nat) r.
(Arity i, Arity d, i <= d) =>
Point d r -> Point i r
projectPoint)
                                                (Point d r :+ extra
r(Point d r :+ extra)
-> ((Point d r :+ extra) -> Point d r :+ extra)
-> Point d r :+ extra
forall a b. a -> (a -> b) -> b
&(Point d r -> Identity (Point d r))
-> (Point d r :+ extra) -> Identity (Point d r :+ extra)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point d r -> Identity (Point d r))
 -> (Point d r :+ extra) -> Identity (Point d r :+ extra))
-> (Point d r -> Point d r)
-> (Point d r :+ extra)
-> Point d r :+ extra
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point d r -> Point d r
forall (i :: Nat) (d :: Nat) r.
(Arity i, Arity d, i <= d) =>
Point d r -> Point i r
projectPoint)

-- | Render a point
renderPoint :: Fractional r => Transformation 3 r -> Point 3 r -> Point 2 r
renderPoint :: Transformation 3 r -> Point 3 r -> Point 2 r
renderPoint = (Point 3 r -> Point 2 r)
-> Transformation 3 r -> Point 3 r -> Point 2 r
forall r g g'.
(Fractional r, IsTransformable g, Dimension g ~ 3,
 NumType g ~ r) =>
(g -> g') -> Transformation 3 r -> g -> g'
renderWithTransform Point 3 r -> Point 2 r
forall (i :: Nat) (d :: Nat) r.
(Arity i, Arity d, i <= d) =>
Point d r -> Point i r
projectPoint

-- | Renders a line segment
renderLineSegment :: Fractional r => Transformation 3 r -> LineSegment 3 p r -> LineSegment 2 p r
renderLineSegment :: Transformation 3 r -> LineSegment 3 p r -> LineSegment 2 p r
renderLineSegment = (LineSegment 3 p r -> LineSegment 2 p r)
-> Transformation 3 r -> LineSegment 3 p r -> LineSegment 2 p r
forall r g g'.
(Fractional r, IsTransformable g, Dimension g ~ 3,
 NumType g ~ r) =>
(g -> g') -> Transformation 3 r -> g -> g'
renderWithTransform LineSegment 3 p r -> LineSegment 2 p r
forall (d :: Nat) (d' :: Nat) q s.
(ImplicitPeano (Peano d), ImplicitPeano (Peano d'),
 ArityPeano (Peano (FromPeano (Peano d'))),
 ArityPeano (Peano (FromPeano (Peano d))), KnownNat d',
 KnownNat (FromPeano (Peano d')), KnownNat (FromPeano (Peano d)),
 KnownNat d,
 Peano (FromPeano (Peano d') + 1)
 ~ 'S (Peano (FromPeano (Peano d'))),
 (d' <=? d) ~ 'True,
 Peano (FromPeano (Peano d) + 1)
 ~ 'S (Peano (FromPeano (Peano d)))) =>
LineSegment d q s -> LineSegment d' q s
project
  where
    project :: LineSegment d q s -> LineSegment d' q s
project LineSegment d q s
s = LineSegment d q s
sLineSegment d q s
-> (LineSegment d q s -> LineSegment d' q s) -> LineSegment d' q s
forall a b. a -> (a -> b) -> b
&((Point d s :+ q) -> Identity (Point d' s :+ q))
-> LineSegment d q s -> Identity (LineSegment d' q s)
forall (d :: Nat) p r (d' :: Nat) q s.
Traversal
  (LineSegment d p r)
  (LineSegment d' q s)
  (Point d r :+ p)
  (Point d' s :+ q)
endPoints(((Point d s :+ q) -> Identity (Point d' s :+ q))
 -> LineSegment d q s -> Identity (LineSegment d' q s))
-> ((Point d s -> Identity (Point d' s))
    -> (Point d s :+ q) -> Identity (Point d' s :+ q))
-> (Point d s -> Identity (Point d' s))
-> LineSegment d q s
-> Identity (LineSegment d' q s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d s -> Identity (Point d' s))
-> (Point d s :+ q) -> Identity (Point d' s :+ q)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point d s -> Identity (Point d' s))
 -> LineSegment d q s -> Identity (LineSegment d' q s))
-> (Point d s -> Point d' s)
-> LineSegment d q s
-> LineSegment d' q s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point d s -> Point d' s
forall (i :: Nat) (d :: Nat) r.
(Arity i, Arity d, i <= d) =>
Point d r -> Point i r
projectPoint



-- | Generic Rendering Function
renderWithTransform           :: (Fractional r, IsTransformable g, Dimension g ~ 3, NumType g ~ r)
                              => (g -> g') -- ^ Projection function
                              -> Transformation 3 r -- ^ The camera transform
                              -> g  -- ^ The thing we wish to transform
                              -> g'
renderWithTransform :: (g -> g') -> Transformation 3 r -> g -> g'
renderWithTransform g -> g'
project Transformation 3 r
t = g -> g'
project (g -> g') -> (g -> g) -> g -> g'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation (Dimension g) (NumType g) -> g -> g
forall g.
IsTransformable g =>
Transformation (Dimension g) (NumType g) -> g -> g
transformBy Transformation 3 r
Transformation (Dimension g) (NumType g)
t