Icosphere.hs

module Geometry.Icosphere where

import RIO

import Data.List (iterate, (!!))
import RIO.Vector.Partial ((!))

import RIO.Vector qualified as Vector
import Geomancy.Vec3 (Vec3, vec3)
import Geomancy.Vec3 qualified as Vec3

import Resource.Model qualified as Model

icosphere :: (Vec3 -> attrs) -> Int -> [Model.Vertex Vec3.Packed attrs]
icosphere mkAttrs n = do
  v <- reverse . concat $ subNormal n icotris_v1
  pure Model.Vertex
    { vPosition = Vec3.Packed v
    , vAttrs    = mkAttrs v
    }

subNormal :: Int -> [[Vec3]] -> [[Vec3]]
subNormal nu tris = map (map Vec3.normalize) $ subdivide nu tris

subdivide :: Int -> [[Vec3]] -> [[Vec3]]
subdivide frequency tris =
  iterate (concatMap subdivideTri) tris !! (frequency - 1)
  where
    subdivideTri = \case
      [v1, v2, v3] ->
        let
          a = midpoint v1 v2
          b = midpoint v2 v3
          c = midpoint v3 v1
        in
          [ [ v1, a, c ]
          , [ v2, b, a ]
          , [ v3, c, b ]
          , [  a, b, c ]
          ]
      _ ->
        error "subdivideTri: not a triangle somehow"

    midpoint a b = (a + b) / 2

icopoints :: Vector Vec3
icopoints = Vector.fromList
  [ vec3 (-1) 0   t
  , vec3   1  0   t
  , vec3 (-1) 0 (-t)
  , vec3   1  0 (-t)

  , vec3   0 (-t) (-1)
  , vec3   0 (-t)   1
  , vec3   0   t  (-1)
  , vec3   0   t    1

  , vec3   t     1  0
  , vec3   t   (-1) 0
  , vec3 (-t)    1  0
  , vec3 (-t)  (-1) 0
  ]
  where
    t = (1.0 + sqrt 5.0) / 2.0

icotris_v1 :: [[Vec3]]
icotris_v1 =
  [ -- faces around point 0
    [ icopoints ! 0
    , icopoints ! 11
    , icopoints ! 5
    ]

  , [ icopoints ! 0
    , icopoints ! 5
    , icopoints ! 1
    ]

  , [ icopoints ! 0
    , icopoints ! 1
    , icopoints ! 7
    ]
{-
  , [ icopoints ! 0
    , icopoints ! 1
    , icopoints ! 7
    ]
-}
  , [ icopoints ! 0
    , icopoints ! 7
    , icopoints ! 10
    ]

  , [ icopoints ! 0
    , icopoints ! 10
    , icopoints ! 11
    ]

    -- 5 adjacent faces

  , [ icopoints ! 1
    , icopoints ! 5
    , icopoints ! 9
    ]

  , [ icopoints ! 5
    , icopoints ! 11
    , icopoints ! 4
    ]

  , [ icopoints ! 11
    , icopoints ! 10
    , icopoints ! 2
    ]

  , [ icopoints ! 10
    , icopoints ! 7
    , icopoints ! 6
    ]

  , [ icopoints ! 7
    , icopoints ! 1
    , icopoints ! 8
    ]

    -- 5 adjacent faces around point 3

  , [ icopoints ! 3
    , icopoints ! 9
    , icopoints ! 4
    ]

  , [ icopoints ! 3
    , icopoints ! 4
    , icopoints ! 2
    ]

  , [ icopoints ! 3
    , icopoints ! 2
    , icopoints ! 6
    ]

  , [ icopoints ! 3
    , icopoints ! 6
    , icopoints ! 8
    ]

  , [ icopoints ! 3
    , icopoints ! 8
    , icopoints ! 9
    ]

    -- 5 adjacent faces

  , [ icopoints ! 4
    , icopoints ! 9
    , icopoints ! 5
    ]

  , [ icopoints ! 2
    , icopoints ! 4
    , icopoints ! 11
    ]

  , [ icopoints ! 6
    , icopoints ! 2
    , icopoints ! 10
    ]

  , [ icopoints ! 8
    , icopoints ! 6
    , icopoints ! 7
    ]

  , [ icopoints ! 9
    , icopoints ! 8
    , icopoints ! 1
    ]
  ]