commit - 4ba7b8ec517c095eba6c742f2e1ecdbaafb92a2e
commit + 7cdb9e10304ebc957c4b0341ff14d24fa978d84f
blob - /dev/null
blob + d5bda2f4042977323694cf603df0e130f9707382 (mode 644)
--- /dev/null
+++ src/S3D/Scenes/House/Underground.idr
@@ -0,0 +1,62 @@
+||| Something to look at below the floor.
+
+module S3D.Scenes.House.Underground
+
+import Math.LinearAlgebra
+import S3D.DrawablePolyhedron
+import S3D.GLProgram.SimpleColour
+import S3D.PhysicalPolyhedron
+import S3D.Polyhedra.Drawable
+import S3D.Polyhedra.Precomputed
+import S3D.Transformable
+import S3D.Transformable.DrawablePolyhedron
+import SolidGeometry.Polyhedron
+
+%default total
+
+polyhedra :
+   List
+   (numPlanes : Nat ** DrawablePolyhedron numPlanes SimpleColour.Attributes True)
+polyhedra =
+  -- A box at the -y pole
+  ( _ **
+    transform
+    [ [0.2, 0, 0, 0]
+    , [0, 0, 0, 0.2]
+    , [0, 0, 0.2, 0]
+    , [0, -1, 0, 0]
+    ]
+    $
+    addTriangulation Precomputed.cube $
+    monochromeCube [1, 0, 0, 1]
+  )
+  ::
+  -- Some spokes radiating out of it
+  [ ( _ **
+      transform
+      [ [x, 0, 0, 0]
+      , [0, 0, 0, w]
+      , [0, 0, z, 0]
+      , [0, -1, 0, 0]
+      ]
+      $
+      addTriangulation Precomputed.cube $
+      monochromeCube [0, 0, 1, 1]
+    )
+  | (x, z, w) <- [(100, 0.1, 0.1), (0.1, 100, 0.1), (0.1, 0.1, 100)]
+  ]
+
+
+export
+underground :
+   List
+   (numPlanes : Nat ** PhysicalPolyhedron numPlanes SimpleColour.Attributes True)
+underground =
+  [ ( numPlanes **
+      MkPhysicalPolyhedron
+      { drawablePolyhedron = p
+      , obstaclePolyhedron = emptyPolyhedron
+      }
+    )
+  | (numPlanes ** p) <- polyhedra
+  ]
blob - a6b7020ccb3f719844f1214b35abd471ccbee6bc
blob + d227901838ac1d2caf527fe43853a1144eb8e1bf
--- src/S3D/Scenes/House.idr
+++ src/S3D/Scenes/House.idr
@@ -46,6 +46,7 @@ import S3D.Scenes.House.FloorLines
 import S3D.Scenes.House.Kitchen
 import S3D.Scenes.House.LivingRoom
 import S3D.Scenes.House.Pantry
+import S3D.Scenes.House.Underground
 import S3D.Scenes.House.Walls
 import S3D.Scenes.House.Yard
 import S3D.Transformable
@@ -90,6 +91,7 @@ physicalPolyhedra : List
                       PhysicalPolyhedron numPlanes SimpleColour.Attributes True
                     )
 physicalPolyhedra =
+  underground ++
   walls ++
   [ (numPlanes ** transform t polyhedron)
   | (room, t) <-