Cube.hs

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
      ]