Introduce cone primitive

elm.json

@@ -19,7 +19,7 @@
         "ianmackenzie/elm-1d-parameter": "1.0.1 <= v < 2.0.0",
         "ianmackenzie/elm-3d-camera": "3.0.0 <= v < 4.0.0",
         "ianmackenzie/elm-float-extra": "1.1.0 <= v < 2.0.0",
-        "ianmackenzie/elm-geometry": "3.4.0 <= v < 4.0.0",
+        "ianmackenzie/elm-geometry": "3.5.0 <= v < 4.0.0",
         "ianmackenzie/elm-geometry-linear-algebra-interop": "2.0.2 <= v < 3.0.0",
         "ianmackenzie/elm-triangular-mesh": "1.0.2 <= v < 2.0.0",
         "ianmackenzie/elm-units": "2.2.0 <= v < 3.0.0",

examples/Demo.elm

@@ -8,6 +8,7 @@ import Browser.Dom
 import Browser.Events
 import Camera3d exposing (Camera3d)
 import Color
+import Cone3d
 import Cylinder3d
 import Direction3d exposing (Direction3d)
 import Frame3d exposing (Frame3d)
@@ -171,7 +172,7 @@ initialModel =
         [ { material = Nonmetal
           , roughness = 0.4
           , color = "#FF5555"
-          , kind = Cylinder
+          , kind = Cone
           , position = Frame3d.atPoint (Point3d.centimeters -15 -3 71.6)
           }
         , { material = Matte
@@ -217,7 +218,7 @@ type alias Object =
 
 type ObjectKind
     = Sphere
-    | Cylinder
+    | Cone
     | Cube
 
 
@@ -503,8 +504,8 @@ objectPanel index obj =
             Cube ->
                 "Cube"
 
-            Cylinder ->
-                "Cylinder"
+            Cone ->
+                "Cone"
         )
         [ materials (OnObjectMaterialChanged index) obj.material
         , colorPicker (OnObjectColorChanged index) "Color" obj.color
@@ -957,8 +958,8 @@ object { kind, position, material, color, roughness } =
         Cube ->
             Scene3d.placeIn position (cube objectMaterial)
 
-        Cylinder ->
-            Scene3d.placeIn position (cylinder objectMaterial)
+        Cone ->
+            Scene3d.placeIn position (cone objectMaterial)
 
 
 cube : Material.Uniform EntityCoordinates -> Scene3d.Entity EntityCoordinates
@@ -973,13 +974,13 @@ sphere material =
         |> Scene3d.sphere (Scene3d.castsShadows True) material
 
 
-cylinder : Material.Uniform EntityCoordinates -> Scene3d.Entity EntityCoordinates
-cylinder material =
-    Cylinder3d.startingAt
+cone : Material.Uniform EntityCoordinates -> Scene3d.Entity EntityCoordinates
+cone material =
+    Cone3d.startingAt
         Point3d.origin
         Direction3d.z
-        { radius = Length.centimeters 8, length = Length.centimeters 20 }
-        |> Scene3d.cylinder (Scene3d.castsShadows True) material
+        { radius = Length.centimeters 8, length = Length.centimeters 25 }
+        |> Scene3d.cone (Scene3d.castsShadows True) material
 
 
 bulb : DirectLight -> Maybe (Scene3d.Entity SceneCoordinates)

examples/elm.json

@@ -18,7 +18,7 @@
             "ianmackenzie/elm-1d-parameter": "1.0.1",
             "ianmackenzie/elm-3d-camera": "3.0.0",
             "ianmackenzie/elm-float-extra": "1.1.0",
-            "ianmackenzie/elm-geometry": "3.4.0",
+            "ianmackenzie/elm-geometry": "3.5.0",
             "ianmackenzie/elm-geometry-linear-algebra-interop": "2.0.1",
             "ianmackenzie/elm-interval": "2.0.0",
             "ianmackenzie/elm-triangular-mesh": "1.0.2",

src/Scene3d.elm

@@ -1,7 +1,7 @@
 module Scene3d exposing
     ( toHtml, unlit, sunny, cloudy, office
     , Entity
-    , quad, block, sphere, cylinder
+    , quad, block, sphere, cylinder, cone
     , mesh
     , group, nothing
     , shadow, withShadow
@@ -51,7 +51,7 @@ specify a material to use. However, different shapes support different kinds of
 materials; `quad`s and `sphere`s support all materials, while `block`s and
 `cylinder`s only support uniform (non-textured) materials.
 
-@docs quad, block, sphere, cylinder
+@docs quad, block, sphere, cylinder, cone
 
 
 ## Meshes
@@ -157,6 +157,7 @@ import BoundingBox3d exposing (BoundingBox3d)
 import Camera3d exposing (Camera3d)
 import Color exposing (Color)
 import Color.Transparent
+import Cone3d exposing (Cone3d)
 import Cylinder3d exposing (Cylinder3d)
 import Direction3d exposing (Direction3d)
 import Duration exposing (Duration)
@@ -275,6 +276,14 @@ cylinder (CastsShadows shadowFlag) givenMaterial givenCylinder =
     Entity.cylinder shadowFlag givenMaterial givenCylinder
 
 
+{-| Draw a cone using the [`Cone3d`](https://package.elm-lang.org/packages/ianmackenzie/elm-geometry/latest/Cone3d)
+type from `elm-geometry`.
+-}
+cone : CastsShadows Bool -> Material.Uniform coordinates -> Cone3d Meters coordinates -> Entity coordinates
+cone (CastsShadows shadowFlag) givenMaterial givenCone =
+    Entity.cone shadowFlag givenMaterial givenCone
+
+
 {-| Draw the given mesh (shape) with the given material. Check out the [`Mesh`](Scene3d-Mesh)
 and [`Material`](Scene3d-Material) modules for how to define meshes and
 materials. Note that the mesh and material types must line up, and this is

src/Scene3d/Entity.elm

@@ -1,6 +1,7 @@
 module Scene3d.Entity exposing
     ( Entity
     , block
+    , cone
     , cylinder
     , empty
     , group
@@ -23,6 +24,7 @@ import Axis3d exposing (Axis3d)
 import Block3d exposing (Block3d)
 import BoundingBox3d exposing (BoundingBox3d)
 import Color exposing (Color)
+import Cone3d exposing (Cone3d)
 import Cylinder3d exposing (Cylinder3d)
 import Direction3d exposing (Direction3d)
 import Float.Extra as Float
@@ -973,6 +975,33 @@ cylinder castsShadow givenMaterial givenCylinder =
         |> placeIn centerFrame
 
 
+cone : Bool -> Material.Uniform coordinates -> Cone3d Meters coordinates -> Entity coordinates
+cone castsShadow givenMaterial givenCone =
+    let
+        (Quantity radius) =
+            Cone3d.radius givenCone
+
+        (Quantity length) =
+            Cone3d.length givenCone
+
+        baseFrame =
+            Frame3d.fromZAxis (Cone3d.axis givenCone)
+
+        baseEntity =
+            mesh givenMaterial Primitives.cone
+
+        untransformedEntity =
+            if castsShadow then
+                group [ baseEntity, shadow Primitives.coneShadow ]
+
+            else
+                baseEntity
+    in
+    untransformedEntity
+        |> transformBy (Transformation.preScale radius radius length)
+        |> placeIn baseFrame
+
+
 shadow : Shadow coordinates -> Entity coordinates
 shadow givenShadow =
     case shadowDrawFunction givenShadow of

src/Scene3d/Primitives.elm

@@ -1,6 +1,8 @@
 module Scene3d.Primitives exposing
     ( block
     , blockShadow
+    , cone
+    , coneShadow
     , cylinder
     , cylinderShadow
     , sphere
@@ -229,6 +231,100 @@ cylinder =
     Mesh.indexedFaces triangularMesh |> Mesh.cullBackFaces
 
 
+cone : Mesh.Uniform coordinates
+cone =
+    let
+        radius =
+            Length.meters 1
+
+        subdivisions =
+            72
+
+        elevationAngle =
+            Angle.degrees 45
+
+        wedgeAngle =
+            Angle.turns 1 |> Quantity.divideBy (toFloat subdivisions)
+
+        negativeZVector =
+            Direction3d.negativeZ |> Direction3d.toVector
+
+        bottomZ =
+            Quantity.zero
+
+        topZ =
+            Length.meters 1
+
+        basePoint =
+            Point3d.xyz zero zero bottomZ
+
+        tipPoint =
+            Point3d.xyz zero zero topZ
+
+        wedge startIndex =
+            let
+                startAngle =
+                    wedgeAngle |> Quantity.multiplyBy (toFloat startIndex)
+
+                endIndex =
+                    startIndex + 1 |> modBy subdivisions
+
+                endAngle =
+                    wedgeAngle |> Quantity.multiplyBy (toFloat endIndex)
+
+                tipAngle =
+                    wedgeAngle |> Quantity.multiplyBy (toFloat endIndex - 0.5)
+
+                startX =
+                    radius |> Quantity.multiplyBy (Angle.cos startAngle)
+
+                endX =
+                    radius |> Quantity.multiplyBy (Angle.cos endAngle)
+
+                startY =
+                    radius |> Quantity.multiplyBy (Angle.sin startAngle)
+
+                endY =
+                    radius |> Quantity.multiplyBy (Angle.sin endAngle)
+
+                p0 =
+                    Point3d.xyz startX startY bottomZ
+
+                p1 =
+                    Point3d.xyz endX endY bottomZ
+
+                startNormal =
+                    Direction3d.xyZ startAngle elevationAngle
+                        |> Direction3d.toVector
+
+                endNormal =
+                    Direction3d.xyZ endAngle elevationAngle
+                        |> Direction3d.toVector
+
+                tipNormal =
+                    Direction3d.xyZ tipAngle elevationAngle
+                        |> Direction3d.toVector
+            in
+            [ ( { position = basePoint, normal = negativeZVector }
+              , { position = p1, normal = negativeZVector }
+              , { position = p0, normal = negativeZVector }
+              )
+            , ( { position = p0, normal = startNormal }
+              , { position = p1, normal = endNormal }
+              , { position = tipPoint, normal = tipNormal }
+              )
+            ]
+
+        wedges =
+            List.range 0 (subdivisions - 1)
+                |> List.map wedge
+
+        triangularMesh =
+            TriangularMesh.triangles (List.concat wedges)
+    in
+    Mesh.indexedFaces triangularMesh |> Mesh.cullBackFaces
+
+
 block : Mesh.Uniform coordinates
 block =
     let
@@ -308,3 +404,8 @@ blockShadow =
 cylinderShadow : Mesh.Shadow coordinates
 cylinderShadow =
     Mesh.shadow cylinder
+
+
+coneShadow : Mesh.Shadow coordinates
+coneShadow =
+    Mesh.shadow cone