diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,14 @@ # Changelog for keid-geometry -## 1.0.0.1 +## 0.1.1.1 + +- Added ray-plane intersection and related types. +- Removed unused deps. + +## 0.1.1.0 + +- Removed older list-based icosphere generator. + +## 0.1.0.1 - Added an icosphere generator backed by a mutable vector. diff --git a/keid-geometry.cabal b/keid-geometry.cabal --- a/keid-geometry.cabal +++ b/keid-geometry.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: keid-geometry -version: 0.1.0.1 +version: 0.1.1.1 synopsis: Geometry primitives for Keid engine. category: Game Engine author: IC Rainbow @@ -27,8 +27,12 @@ Geometry.Cube Geometry.Edge Geometry.Face + Geometry.Hit Geometry.Icosphere + Geometry.Intersect + Geometry.Plane Geometry.Quad + Geometry.Ray other-modules: Paths_keid_geometry hs-source-dirs: @@ -97,7 +101,6 @@ , keid-core , mtl , rio >=0.1.12.0 - , rio-app , vector , vulkan default-language: Haskell2010 diff --git a/src/Geometry/Hit.hs b/src/Geometry/Hit.hs new file mode 100644 --- /dev/null +++ b/src/Geometry/Hit.hs @@ -0,0 +1,14 @@ +module Geometry.Hit + ( Hit(..) + ) where + +import RIO + +import Geomancy (Vec3) + +data Hit = Hit + { distance :: Float + , cosine :: Float + , position :: Vec3 + } + deriving (Eq, Ord, Show) diff --git a/src/Geometry/Icosphere.hs b/src/Geometry/Icosphere.hs --- a/src/Geometry/Icosphere.hs +++ b/src/Geometry/Icosphere.hs @@ -3,19 +3,12 @@ , icofaces , icopoints - - , icosphere - , icotris_v1 - , subNormal - , subdivide ) where import RIO -import Data.List (iterate, (!!)) import Geomancy.Vec3 (Vec3, vec3) import Geomancy.Vec3 qualified as Vec3 -import Resource.Model qualified as Model import Data.Vector qualified as Vector import Data.Vector.Mutable qualified as Mutable import RIO.Vector.Partial ((!)) @@ -184,150 +177,3 @@ ] 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 - ] - ] - -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 diff --git a/src/Geometry/Intersect.hs b/src/Geometry/Intersect.hs new file mode 100644 --- /dev/null +++ b/src/Geometry/Intersect.hs @@ -0,0 +1,40 @@ +module Geometry.Intersect + ( Hit + , ray'plane + ) where + +import RIO + +import Geomancy.Vec3 (dot, (^*)) + +import Geometry.Hit (Hit(..)) +import Geometry.Plane (Plane) +import Geometry.Plane qualified as Plane +import Geometry.Ray (Ray) +import Geometry.Ray qualified as Ray + +ray'plane + :: Ray + -> Plane + -> Maybe Hit +ray'plane ray plane = + -- XXX: Ignore "glancing" hits from either side of a plane + if (abs denom > eps) then + Just Hit + { distance = t + , cosine = denom + , position = hit + } + else + Nothing + where + eps = 1/32 + + denom = + Plane.normal plane `dot` Ray.direction ray + + t = + negate ((Plane.normal plane `dot` Ray.origin ray) + Plane.depth plane) / denom + + hit = + Ray.origin ray + Ray.direction ray ^* t diff --git a/src/Geometry/Plane.hs b/src/Geometry/Plane.hs new file mode 100644 --- /dev/null +++ b/src/Geometry/Plane.hs @@ -0,0 +1,61 @@ +module Geometry.Plane + ( Plane(..) + , xyBack + , xyFront + , xzUp + , xzDown + , yzLeft + , yzRight + ) where + +import RIO + +import Geomancy (Vec3, vec3) + +data Plane = Plane + { normal :: Vec3 + , depth :: Float + } + deriving (Show) + +-- | XY plane facing back. +xyBack :: Float -> Plane +xyBack d = Plane + { normal = vec3 0 0 (-1) + , depth = d + } + +-- | XY plane facing front. +xyFront :: Float -> Plane +xyFront d = Plane + { normal = vec3 0 0 1 + , depth = d + } + +-- | XZ plane facing up. +xzUp :: Float -> Plane +xzUp d = Plane + { normal = vec3 0 (-1) 0 + , depth = d + } + +-- | XZ plane facing down. +xzDown :: Float -> Plane +xzDown d = Plane + { normal = vec3 0 1 0 + , depth = d + } + +-- | YZ plane facing left. +yzLeft :: Float -> Plane +yzLeft d = Plane + { normal = vec3 (-1) 0 0 + , depth = d + } + +-- | YZ plane facing right. +yzRight :: Float -> Plane +yzRight d = Plane + { normal = vec3 1 0 0 + , depth = d + } diff --git a/src/Geometry/Ray.hs b/src/Geometry/Ray.hs new file mode 100644 --- /dev/null +++ b/src/Geometry/Ray.hs @@ -0,0 +1,20 @@ +module Geometry.Ray + ( Ray(..) + , fromSegment + ) where + +import RIO + +import Geomancy (Vec3) + +data Ray = Ray + { origin :: Vec3 + , direction :: Vec3 + } + deriving (Show) + +fromSegment :: Vec3 -> Vec3 -> Ray +fromSegment origin target = Ray + { origin = origin + , direction = target - origin + }