module Geometry.Cube where import RIO import Geomancy (Vec3, Vec4, vec3, vec4) import Geomancy.Vec3 qualified as Vec3 import Resource.Model qualified as Model data Vertices a = Vertices { vLTN :: a , vLTF :: a , vLBN :: a , vLBF :: a , vRTN :: a , vRTF :: a , vRBN :: a , vRBF :: a } deriving (Eq, Ord, Show, Functor, Foldable, Traversable) -- | Unit cube vertices centered at (0,0,0). positions :: Vertices Vec3 positions = Vertices { vLTN = vec3 (-0.5) (-0.5) (-0.5) , vLTF = vec3 (-0.5) (-0.5) 0.5 , vLBN = vec3 (-0.5) 0.5 (-0.5) , vLBF = vec3 (-0.5) 0.5 0.5 , vRTN = vec3 0.5 (-0.5) (-0.5) , vRTF = vec3 0.5 (-0.5) 0.5 , vRBN = vec3 0.5 0.5 (-0.5) , vRBF = vec3 0.5 0.5 0.5 } instance Applicative Vertices where {-# INLINE pure #-} pure x = Vertices { vLTN = x , vLTF = x , vLBN = x , vLBF = x , vRTN = x , vRTF = x , vRBN = x , vRBF = x } funcs <*> args = Vertices { vLTN = vLTN funcs $ vLTN args , vLTF = vLTF funcs $ vLTF args , vLBN = vLBN funcs $ vLBN args , vLBF = vLBF funcs $ vLBF args , vRTN = vRTN funcs $ vRTN args , vRTF = vRTF funcs $ vRTF args , vRBN = vRBN funcs $ vRBN args , vRBF = vRBF funcs $ vRBF args } edges :: [Vec3] edges = [ -- XXX: top plane vLTF , vLTN , vRTF , vRTN , vLTF , vRTF , vLTN , vRTN -- XXX: bottom plane , vLBF , vLBN , vRBF , vRBN , vLBF , vRBF , vLBN , vRBN -- XXX: vertical bars , vLTN , vLBN , vRTN , vRBN , vLTF , vLBF , vRTF , vRBF ] where Vertices{..} = positions bbWireColored :: [Model.Vertex Vec3.Packed Vec4] bbWireColored = zipWith Model.Vertex (map Vec3.Packed edges) colors where colors = [ -- XXX: top plane - red vec4 1 0 0 1 , vec4 1 0 0 1 , vec4 1 0 0 1 , vec4 1 0 0 1 , vec4 1 0 0 1 , vec4 1 0 0 1 , vec4 1 0 0 1 , vec4 1 0 0 1 -- XXX: bottom plane - green , vec4 0 1 0 1 , vec4 0 1 0 1 , vec4 0 1 0 1 , vec4 0 1 0 1 , vec4 0 1 0 1 , vec4 0 1 0 1 , vec4 0 1 0 1 , vec4 0 1 0 1 -- XXX: vertical bars - blue , vec4 0 0 1 1 , vec4 0 0 1 1 , vec4 0 0 1 1 , vec4 0 0 1 1 , vec4 0 0 1 1 , vec4 0 0 1 1 , vec4 0 0 1 1 , vec4 0 0 1 1 ]