{-# LANGUAGE TemplateHaskell #-}
module Brick3D.Type (
Position
, Rotation
, DCPosition
, SCPosition
, Normal
, Vertex(Vertex)
, v_position
, DCVertex(DCVertex)
, dcv_position
, zBuffer
, fromVertex
, SCVertex(SCVertex)
, scv_position
, depth
, PrimitiveBase(..)
, Primitive
, calcNormal
, DCPrimitive(DCPrimitive)
, unPrimitive
, normal
, vertices
, toDCPrimitive
) where
import Linear.V3 (V3(..), cross, _x, _y, _z)
import Linear.V2 (V2(..))
import Linear.Matrix (M33(..))
import Lens.Micro.Platform
type Position = V3 Float
type Rotation = M33 Float
type DCPosition = V2 Float
type SCPosition = V2 Int
type Normal = V3 Float
data Vertex = Vertex { Vertex -> Position
_v_position :: Position
} deriving (Int -> Vertex -> ShowS
[Vertex] -> ShowS
Vertex -> String
(Int -> Vertex -> ShowS)
-> (Vertex -> String) -> ([Vertex] -> ShowS) -> Show Vertex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vertex] -> ShowS
$cshowList :: [Vertex] -> ShowS
show :: Vertex -> String
$cshow :: Vertex -> String
showsPrec :: Int -> Vertex -> ShowS
$cshowsPrec :: Int -> Vertex -> ShowS
Show, Vertex -> Vertex -> Bool
(Vertex -> Vertex -> Bool)
-> (Vertex -> Vertex -> Bool) -> Eq Vertex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vertex -> Vertex -> Bool
$c/= :: Vertex -> Vertex -> Bool
== :: Vertex -> Vertex -> Bool
$c== :: Vertex -> Vertex -> Bool
Eq, Eq Vertex
Eq Vertex
-> (Vertex -> Vertex -> Ordering)
-> (Vertex -> Vertex -> Bool)
-> (Vertex -> Vertex -> Bool)
-> (Vertex -> Vertex -> Bool)
-> (Vertex -> Vertex -> Bool)
-> (Vertex -> Vertex -> Vertex)
-> (Vertex -> Vertex -> Vertex)
-> Ord Vertex
Vertex -> Vertex -> Bool
Vertex -> Vertex -> Ordering
Vertex -> Vertex -> Vertex
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Vertex -> Vertex -> Vertex
$cmin :: Vertex -> Vertex -> Vertex
max :: Vertex -> Vertex -> Vertex
$cmax :: Vertex -> Vertex -> Vertex
>= :: Vertex -> Vertex -> Bool
$c>= :: Vertex -> Vertex -> Bool
> :: Vertex -> Vertex -> Bool
$c> :: Vertex -> Vertex -> Bool
<= :: Vertex -> Vertex -> Bool
$c<= :: Vertex -> Vertex -> Bool
< :: Vertex -> Vertex -> Bool
$c< :: Vertex -> Vertex -> Bool
compare :: Vertex -> Vertex -> Ordering
$ccompare :: Vertex -> Vertex -> Ordering
$cp1Ord :: Eq Vertex
Ord)
makeLenses ''Vertex
data DCVertex = DCVertex { DCVertex -> DCPosition
_dcv_position :: DCPosition
, DCVertex -> Float
_zBuffer :: Float
} deriving (Int -> DCVertex -> ShowS
[DCVertex] -> ShowS
DCVertex -> String
(Int -> DCVertex -> ShowS)
-> (DCVertex -> String) -> ([DCVertex] -> ShowS) -> Show DCVertex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DCVertex] -> ShowS
$cshowList :: [DCVertex] -> ShowS
show :: DCVertex -> String
$cshow :: DCVertex -> String
showsPrec :: Int -> DCVertex -> ShowS
$cshowsPrec :: Int -> DCVertex -> ShowS
Show, DCVertex -> DCVertex -> Bool
(DCVertex -> DCVertex -> Bool)
-> (DCVertex -> DCVertex -> Bool) -> Eq DCVertex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DCVertex -> DCVertex -> Bool
$c/= :: DCVertex -> DCVertex -> Bool
== :: DCVertex -> DCVertex -> Bool
$c== :: DCVertex -> DCVertex -> Bool
Eq, Eq DCVertex
Eq DCVertex
-> (DCVertex -> DCVertex -> Ordering)
-> (DCVertex -> DCVertex -> Bool)
-> (DCVertex -> DCVertex -> Bool)
-> (DCVertex -> DCVertex -> Bool)
-> (DCVertex -> DCVertex -> Bool)
-> (DCVertex -> DCVertex -> DCVertex)
-> (DCVertex -> DCVertex -> DCVertex)
-> Ord DCVertex
DCVertex -> DCVertex -> Bool
DCVertex -> DCVertex -> Ordering
DCVertex -> DCVertex -> DCVertex
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DCVertex -> DCVertex -> DCVertex
$cmin :: DCVertex -> DCVertex -> DCVertex
max :: DCVertex -> DCVertex -> DCVertex
$cmax :: DCVertex -> DCVertex -> DCVertex
>= :: DCVertex -> DCVertex -> Bool
$c>= :: DCVertex -> DCVertex -> Bool
> :: DCVertex -> DCVertex -> Bool
$c> :: DCVertex -> DCVertex -> Bool
<= :: DCVertex -> DCVertex -> Bool
$c<= :: DCVertex -> DCVertex -> Bool
< :: DCVertex -> DCVertex -> Bool
$c< :: DCVertex -> DCVertex -> Bool
compare :: DCVertex -> DCVertex -> Ordering
$ccompare :: DCVertex -> DCVertex -> Ordering
$cp1Ord :: Eq DCVertex
Ord)
makeLenses ''DCVertex
data SCVertex = SCVertex { SCVertex -> SCPosition
_scv_position :: SCPosition
, SCVertex -> Float
_depth :: Float
} deriving (Int -> SCVertex -> ShowS
[SCVertex] -> ShowS
SCVertex -> String
(Int -> SCVertex -> ShowS)
-> (SCVertex -> String) -> ([SCVertex] -> ShowS) -> Show SCVertex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SCVertex] -> ShowS
$cshowList :: [SCVertex] -> ShowS
show :: SCVertex -> String
$cshow :: SCVertex -> String
showsPrec :: Int -> SCVertex -> ShowS
$cshowsPrec :: Int -> SCVertex -> ShowS
Show, SCVertex -> SCVertex -> Bool
(SCVertex -> SCVertex -> Bool)
-> (SCVertex -> SCVertex -> Bool) -> Eq SCVertex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SCVertex -> SCVertex -> Bool
$c/= :: SCVertex -> SCVertex -> Bool
== :: SCVertex -> SCVertex -> Bool
$c== :: SCVertex -> SCVertex -> Bool
Eq, Eq SCVertex
Eq SCVertex
-> (SCVertex -> SCVertex -> Ordering)
-> (SCVertex -> SCVertex -> Bool)
-> (SCVertex -> SCVertex -> Bool)
-> (SCVertex -> SCVertex -> Bool)
-> (SCVertex -> SCVertex -> Bool)
-> (SCVertex -> SCVertex -> SCVertex)
-> (SCVertex -> SCVertex -> SCVertex)
-> Ord SCVertex
SCVertex -> SCVertex -> Bool
SCVertex -> SCVertex -> Ordering
SCVertex -> SCVertex -> SCVertex
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SCVertex -> SCVertex -> SCVertex
$cmin :: SCVertex -> SCVertex -> SCVertex
max :: SCVertex -> SCVertex -> SCVertex
$cmax :: SCVertex -> SCVertex -> SCVertex
>= :: SCVertex -> SCVertex -> Bool
$c>= :: SCVertex -> SCVertex -> Bool
> :: SCVertex -> SCVertex -> Bool
$c> :: SCVertex -> SCVertex -> Bool
<= :: SCVertex -> SCVertex -> Bool
$c<= :: SCVertex -> SCVertex -> Bool
< :: SCVertex -> SCVertex -> Bool
$c< :: SCVertex -> SCVertex -> Bool
compare :: SCVertex -> SCVertex -> Ordering
$ccompare :: SCVertex -> SCVertex -> Ordering
$cp1Ord :: Eq SCVertex
Ord)
makeLenses ''SCVertex
fromVertex :: Vertex -> DCVertex
fromVertex :: Vertex -> DCVertex
fromVertex Vertex
v | Vertex
vVertex -> Getting Float Vertex Float -> Float
forall s a. s -> Getting a s a -> a
^.(Position -> Const Float Position) -> Vertex -> Const Float Vertex
Lens' Vertex Position
v_position((Position -> Const Float Position)
-> Vertex -> Const Float Vertex)
-> ((Float -> Const Float Float)
-> Position -> Const Float Position)
-> Getting Float Vertex Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Float -> Const Float Float) -> Position -> Const Float Position
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 = DCPosition -> Float -> DCVertex
DCVertex DCPosition
dcposition Float
0
| Bool
otherwise = DCPosition -> Float -> DCVertex
DCVertex DCPosition
dcposition (Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Vertex
vVertex -> Getting Float Vertex Float -> Float
forall s a. s -> Getting a s a -> a
^.(Position -> Const Float Position) -> Vertex -> Const Float Vertex
Lens' Vertex Position
v_position((Position -> Const Float Position)
-> Vertex -> Const Float Vertex)
-> ((Float -> Const Float Float)
-> Position -> Const Float Position)
-> Getting Float Vertex Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Float -> Const Float Float) -> Position -> Const Float Position
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z)
where
dcposition :: DCPosition
dcposition = Float -> Float -> DCPosition
forall a. a -> a -> V2 a
V2 (Vertex
vVertex -> Getting Float Vertex Float -> Float
forall s a. s -> Getting a s a -> a
^.(Position -> Const Float Position) -> Vertex -> Const Float Vertex
Lens' Vertex Position
v_position((Position -> Const Float Position)
-> Vertex -> Const Float Vertex)
-> ((Float -> Const Float Float)
-> Position -> Const Float Position)
-> Getting Float Vertex Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Float -> Const Float Float) -> Position -> Const Float Position
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x) (Vertex
vVertex -> Getting Float Vertex Float -> Float
forall s a. s -> Getting a s a -> a
^.(Position -> Const Float Position) -> Vertex -> Const Float Vertex
Lens' Vertex Position
v_position((Position -> Const Float Position)
-> Vertex -> Const Float Vertex)
-> ((Float -> Const Float Float)
-> Position -> Const Float Position)
-> Getting Float Vertex Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Float -> Const Float Float) -> Position -> Const Float Position
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y)
data PrimitiveBase vtype = Point vtype
| Triangle vtype vtype vtype
deriving (Int -> PrimitiveBase vtype -> ShowS
[PrimitiveBase vtype] -> ShowS
PrimitiveBase vtype -> String
(Int -> PrimitiveBase vtype -> ShowS)
-> (PrimitiveBase vtype -> String)
-> ([PrimitiveBase vtype] -> ShowS)
-> Show (PrimitiveBase vtype)
forall vtype. Show vtype => Int -> PrimitiveBase vtype -> ShowS
forall vtype. Show vtype => [PrimitiveBase vtype] -> ShowS
forall vtype. Show vtype => PrimitiveBase vtype -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimitiveBase vtype] -> ShowS
$cshowList :: forall vtype. Show vtype => [PrimitiveBase vtype] -> ShowS
show :: PrimitiveBase vtype -> String
$cshow :: forall vtype. Show vtype => PrimitiveBase vtype -> String
showsPrec :: Int -> PrimitiveBase vtype -> ShowS
$cshowsPrec :: forall vtype. Show vtype => Int -> PrimitiveBase vtype -> ShowS
Show, PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
(PrimitiveBase vtype -> PrimitiveBase vtype -> Bool)
-> (PrimitiveBase vtype -> PrimitiveBase vtype -> Bool)
-> Eq (PrimitiveBase vtype)
forall vtype.
Eq vtype =>
PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
$c/= :: forall vtype.
Eq vtype =>
PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
== :: PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
$c== :: forall vtype.
Eq vtype =>
PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
Eq, Eq (PrimitiveBase vtype)
Eq (PrimitiveBase vtype)
-> (PrimitiveBase vtype -> PrimitiveBase vtype -> Ordering)
-> (PrimitiveBase vtype -> PrimitiveBase vtype -> Bool)
-> (PrimitiveBase vtype -> PrimitiveBase vtype -> Bool)
-> (PrimitiveBase vtype -> PrimitiveBase vtype -> Bool)
-> (PrimitiveBase vtype -> PrimitiveBase vtype -> Bool)
-> (PrimitiveBase vtype
-> PrimitiveBase vtype -> PrimitiveBase vtype)
-> (PrimitiveBase vtype
-> PrimitiveBase vtype -> PrimitiveBase vtype)
-> Ord (PrimitiveBase vtype)
PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
PrimitiveBase vtype -> PrimitiveBase vtype -> Ordering
PrimitiveBase vtype -> PrimitiveBase vtype -> PrimitiveBase vtype
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall vtype. Ord vtype => Eq (PrimitiveBase vtype)
forall vtype.
Ord vtype =>
PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
forall vtype.
Ord vtype =>
PrimitiveBase vtype -> PrimitiveBase vtype -> Ordering
forall vtype.
Ord vtype =>
PrimitiveBase vtype -> PrimitiveBase vtype -> PrimitiveBase vtype
min :: PrimitiveBase vtype -> PrimitiveBase vtype -> PrimitiveBase vtype
$cmin :: forall vtype.
Ord vtype =>
PrimitiveBase vtype -> PrimitiveBase vtype -> PrimitiveBase vtype
max :: PrimitiveBase vtype -> PrimitiveBase vtype -> PrimitiveBase vtype
$cmax :: forall vtype.
Ord vtype =>
PrimitiveBase vtype -> PrimitiveBase vtype -> PrimitiveBase vtype
>= :: PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
$c>= :: forall vtype.
Ord vtype =>
PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
> :: PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
$c> :: forall vtype.
Ord vtype =>
PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
<= :: PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
$c<= :: forall vtype.
Ord vtype =>
PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
< :: PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
$c< :: forall vtype.
Ord vtype =>
PrimitiveBase vtype -> PrimitiveBase vtype -> Bool
compare :: PrimitiveBase vtype -> PrimitiveBase vtype -> Ordering
$ccompare :: forall vtype.
Ord vtype =>
PrimitiveBase vtype -> PrimitiveBase vtype -> Ordering
$cp1Ord :: forall vtype. Ord vtype => Eq (PrimitiveBase vtype)
Ord)
makeLenses ''PrimitiveBase
type Primitive = PrimitiveBase Vertex
calcNormal :: Primitive -> Normal
calcNormal :: Primitive -> Position
calcNormal (Point Vertex
p) = Vertex
pVertex -> Getting Position Vertex Position -> Position
forall s a. s -> Getting a s a -> a
^.Getting Position Vertex Position
Lens' Vertex Position
v_position
calcNormal (Triangle Vertex
v1 Vertex
v2 Vertex
_) = (Vertex
v1Vertex -> Getting Position Vertex Position -> Position
forall s a. s -> Getting a s a -> a
^.Getting Position Vertex Position
Lens' Vertex Position
v_position) Position -> Position -> Position
forall a. Num a => V3 a -> V3 a -> V3 a
`cross` (Vertex
v2Vertex -> Getting Position Vertex Position -> Position
forall s a. s -> Getting a s a -> a
^.Getting Position Vertex Position
Lens' Vertex Position
v_position)
data DCPrimitive = DCPrimitive { DCPrimitive -> PrimitiveBase DCVertex
_unPrimitive :: PrimitiveBase DCVertex
, DCPrimitive -> Position
_normal :: Normal
}
makeLenses ''DCPrimitive
vertices :: Traversal' Primitive Vertex
vertices :: (Vertex -> f Vertex) -> Primitive -> f Primitive
vertices Vertex -> f Vertex
f (Point Vertex
v) = Vertex -> Primitive
forall vtype. vtype -> PrimitiveBase vtype
Point (Vertex -> Primitive) -> f Vertex -> f Primitive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vertex -> f Vertex
f Vertex
v
vertices Vertex -> f Vertex
f (Triangle Vertex
v1 Vertex
v2 Vertex
v3) = Vertex -> Vertex -> Vertex -> Primitive
forall vtype. vtype -> vtype -> vtype -> PrimitiveBase vtype
Triangle (Vertex -> Vertex -> Vertex -> Primitive)
-> f Vertex -> f (Vertex -> Vertex -> Primitive)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vertex -> f Vertex
f Vertex
v1 f (Vertex -> Vertex -> Primitive)
-> f Vertex -> f (Vertex -> Primitive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vertex -> f Vertex
f Vertex
v2 f (Vertex -> Primitive) -> f Vertex -> f Primitive
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vertex -> f Vertex
f Vertex
v3
toDCPrimitive :: Applicative f => (Vertex -> f DCVertex) -> Primitive -> f DCPrimitive
toDCPrimitive :: (Vertex -> f DCVertex) -> Primitive -> f DCPrimitive
toDCPrimitive Vertex -> f DCVertex
f p :: Primitive
p@(Point Vertex
v) = let norm :: Position
norm = Primitive -> Position
calcNormal Primitive
p
in (PrimitiveBase DCVertex -> Position -> DCPrimitive)
-> Position -> PrimitiveBase DCVertex -> DCPrimitive
forall a b c. (a -> b -> c) -> b -> a -> c
flip PrimitiveBase DCVertex -> Position -> DCPrimitive
DCPrimitive Position
norm (PrimitiveBase DCVertex -> DCPrimitive)
-> f (PrimitiveBase DCVertex) -> f DCPrimitive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DCVertex -> PrimitiveBase DCVertex
forall vtype. vtype -> PrimitiveBase vtype
Point (DCVertex -> PrimitiveBase DCVertex)
-> f DCVertex -> f (PrimitiveBase DCVertex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vertex -> f DCVertex
f Vertex
v)
toDCPrimitive Vertex -> f DCVertex
f tri :: Primitive
tri@(Triangle Vertex
v1 Vertex
v2 Vertex
v3) = let norm :: Position
norm = Primitive -> Position
calcNormal Primitive
tri
in (PrimitiveBase DCVertex -> Position -> DCPrimitive)
-> Position -> PrimitiveBase DCVertex -> DCPrimitive
forall a b c. (a -> b -> c) -> b -> a -> c
flip PrimitiveBase DCVertex -> Position -> DCPrimitive
DCPrimitive Position
norm (PrimitiveBase DCVertex -> DCPrimitive)
-> f (PrimitiveBase DCVertex) -> f DCPrimitive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DCVertex -> DCVertex -> DCVertex -> PrimitiveBase DCVertex
forall vtype. vtype -> vtype -> vtype -> PrimitiveBase vtype
Triangle (DCVertex -> DCVertex -> DCVertex -> PrimitiveBase DCVertex)
-> f DCVertex -> f (DCVertex -> DCVertex -> PrimitiveBase DCVertex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vertex -> f DCVertex
f Vertex
v1 f (DCVertex -> DCVertex -> PrimitiveBase DCVertex)
-> f DCVertex -> f (DCVertex -> PrimitiveBase DCVertex)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vertex -> f DCVertex
f Vertex
v2 f (DCVertex -> PrimitiveBase DCVertex)
-> f DCVertex -> f (PrimitiveBase DCVertex)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vertex -> f DCVertex
f Vertex
v3)