Add various helpers for creating polyhedra

src/Dodge/Creature/Inanimate.hs

@@ -41,7 +41,7 @@ initialiseLamp :: CRUpdate
 initialiseLamp w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLamp i)
   where
     i = IM.newKey $ _lightSources $ f w -- to give different lights different keys
-    addLS = over lightSources (IM.insert i (lightAt (x,y,0) i))
+    addLS = over lightSources (IM.insert i (lightAt (x,y,100) i))
     (x,y) = _crPos cr
 
 updateLamp :: Int -> CRUpdate
@@ -53,7 +53,7 @@ updateLamp i = unrandUpdate handleLS internalUpdate
         | otherwise    = w & lightSources . ix i . lsPos .~ f cPos
       where
         cPos = _crPos cr
-        f (x,y) = (x,y,0)
+        f (x,y) = (x,y,100)
     internalUpdate cr 
         | _crHP cr < 0 = Nothing
         | otherwise    = Just $ doDamage cr

src/Dodge/LightSources.hs

@@ -14,7 +14,7 @@ lightAt (x,y,z) i =
     LS {_lsID = i
        ,_lsPos = (x,y,z)
        ,_lsDir = 0
-       ,_lsRad = 500
+       ,_lsRad = 300
        ,_lsIntensity = 0.75
        }
 basicLS :: PSType

src/Dodge/Picture.hs

@@ -4,6 +4,7 @@ Creates uniform sizes and commands for the Dodge modules. -}
 module Dodge.Picture
     where
 import Geometry
+import Geometry.Vector3D
 import Geometry.Data
 import Picture
 

src/Dodge/Render.hs

@@ -60,7 +60,7 @@ doDrawing pdata w = do
     bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
 
     -- store floor position into buffer
-    let addC (xx,yy) = (xx,yy,0.1)
+    let addC (xx,yy) = (xx,yy,0)
     nsurfVs <- F.foldM (pokeShader (_lightingSurfaceShader pdata)) [Render3 
         $ polyToTris $ map addC $ screenPolygon w ]
     bindShaderBuffers [_lightingSurfaceShader pdata] [nsurfVs]
@@ -123,7 +123,7 @@ doDrawing pdata w = do
             drawShader (_grayscaleShader pdata) 4
     blend $= Enabled
     
-    bufferUBO $ perspectiveMatrixc 0 1 (0,0) (2,2)
+    bufferUBO $ isoMatrix 0 1 (0,0) (2,2)
 
     blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
     _ <- renderFoldable pdata (picToLTree Nothing $ fixedCoordPictures w)
@@ -131,8 +131,7 @@ doDrawing pdata w = do
     return (eTicks - sTicks)
 
 --------------------------------------------------------------------------------
-
--- note we currently assume there is only one UBO, we only bind it once at setup
+-- note: currently assume there is only one UBO, we only bind it once at setup
 bufferUBO :: [Float] -> IO ()
 bufferUBO mat = withArray mat $ \ptr ->
     bufferSubData UniformBuffer WriteToBuffer 0 64 ptr

src/Dodge/Room/Foreground.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 module Dodge.Room.Foreground
     where
 import Dodge.Picture
@@ -5,6 +6,8 @@ import Dodge.Base
 import Picture
 import Geometry
 import Geometry.Data
+import Geometry.Vector3D
+import Polyhedra
 
 import Data.List
 import Data.Maybe
@@ -45,13 +48,17 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
     yN = d * 0.5 *.* normalizeV (pa -.- pb)
 
 highPipe :: Point2 -> Point2 -> Picture
-highPipe x y = pictures 
-    [setDepth 100 $ thickLine [x,y] 10
-    ,setDepth 90 $ color orange $ thickLine [x,y] 10
+highPipe x@(xx,xy) y = pictures 
+    --[color orange . pictures . map (poly3D . map ( ( , black) . ( +.+.+ (x,y,50)))) $ boxXYZ 
+    [ color orange . pictures . map (poly3D . map ( (,black) . (+.+.+ (xx,xy,50)))) 
+        $ boxABC (a,b,0) (a',b',0) (0,0,10)
     ,verticalPipe 5 orange x 0 100 
     ,verticalPipe 5 orange y 0 100 
     ,verticalPipe 5 orange (0.5 *.* (x +.+ y)) 50 100 
     ]
+  where
+    (a,b) = y -.- x
+    (a',b') = 10 *.* (normalizeV $ vNormal (a,b))
 
 girderZ :: Float -> Point2 -> Point2 -> Picture
 girderZ w x y = setDepth 50 $ color red $ pictures $