Cleanup

src/Dodge/Creature/Inanimate.hs

@@ -10,16 +10,11 @@ module Dodge.Creature.Inanimate
 import Dodge.Data
 import Dodge.Creature.Lamp
 import Dodge.WorldEvent.Explosion
-import Dodge.Creature.Picture
 import Dodge.Spark
 import Dodge.Default
 import Dodge.Creature.State
-import Picture
 import qualified IntMapHelp as IM
 import Geometry
---import Geometry.Data
---import Geometry.Vector3D
-import Shape
 import Dodge.SoundLogic
 import LensHelp
 
@@ -30,11 +25,7 @@ barrel :: Creature
 barrel = defaultInanimate
     { _crUpdate = updateBarrel
     , _crHP = 500
-    , _crType = DrawnCreature $ picAtCrPos $ setDepth 20 $ pictures 
-        [ color orange $ circleSolid 10
-        , setDepth 0.049 . color (greyN 0.5) $ circleSolid 8
-        , color (greyN 0.5) $ circleSolid 8
-        ]
+    , _crType = Barreloid
     , _crState = defaultState 
         {_csSpState = Barrel []
         }
@@ -45,10 +36,7 @@ explosiveBarrel :: Creature
 explosiveBarrel = defaultInanimate
     { _crUpdate = updateExpBarrel
     , _crHP = 400
-    , _crType = DrawnCreature $ shapeAtCrPos
-        . colorSH orange
-        . upperPrismPoly 20
-        $ polyCirc 4 10
+    , _crType = Barreloid
     , _crState = defaultState 
         {_csSpState = Barrel []
         }

src/Dodge/Creature/Lamp.hs

@@ -5,19 +5,14 @@ module Dodge.Creature.Lamp
 import Dodge.Data
 import Dodge.Material.Sound
 import Dodge.Default
-import Dodge.Creature.Picture
 import Dodge.LightSource
 import Dodge.WorldEvent.Flash
 import Dodge.WorldEvent.Sound
 import Dodge.Creature.State
 import Geometry
-import Picture
-import Polyhedra
 import qualified IntMapHelp as IM
 import LensHelp
 
---import qualified Streaming.Prelude as S
-
 colorLamp 
     :: Point3   -- color of lamp
     -> Float    -- height of lamp
@@ -25,7 +20,7 @@ colorLamp
 colorLamp col h = defaultInanimate
     { _crUpdate = initialiseColorLamp col h
     , _crHP = 100
-    , _crType = DrawnCreature $ picAtCrPosNoRot (lampCrPic h)
+    , _crType = Lampoid h
     , _crRad = 3
     , _crMass = 3
     }
@@ -33,14 +28,6 @@ colorLamp col h = defaultInanimate
 lamp :: Float -> Creature
 lamp = colorLamp 0.75
 
-lampCrPic :: Float -> Picture
-lampCrPic h = pictures 
-    [ setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
-    , foldMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
-    ]
-  where
-    f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] BottomLayer polyNum
-
 initialiseColorLamp :: Point3 -> Float -> Creature -> World -> World
 initialiseColorLamp col h cr w = w
     & lightSources . at lsid ?~ lsColPosID col (addZ h $ _crPos cr) lsid

src/Dodge/Creature/State.hs

@@ -63,7 +63,7 @@ checkDeath cr w
   where
     removecr
         | _crID cr == 0 = (creatures . ix (_crID cr) . crUpdate .~ const id)
-            . (creatures . ix (_crID cr) . crType .~ DrawnCreature (const mempty))
+            . (creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
             . (creatures . ix (_crID cr) . crHP   .~ 0) 
             -- hack to get around player creature being killed but left with more than 0 hp
         | otherwise  = creatures . at (_crID cr) .~ Nothing

src/Dodge/Data.hs

@@ -312,7 +312,9 @@ data CreatureType
         , _skinUpper    :: Color
         , _skinLower    :: Color
         }
-    | DrawnCreature { _cdDraw :: Creature -> SPic }
+    | Barreloid
+    | Lampoid {_lampHeight :: Float}
+    | NonDrawnCreature
 data Creature = Creature
     { _crPos            :: Point2
     , _crOldPos         :: Point2

src/Dodge/Placement/Instance/Button.hs

@@ -12,7 +12,6 @@ import ShapePicture
 
 import Data.Maybe
 import Control.Lens
-import qualified Data.IntMap.Strict as IM
 
 triggerSwitchSPic :: (Button -> SPic) -> PlacementSpot -> Placement
 triggerSwitchSPic sdraw ps = psPtCont ps (PutTrigger False)
@@ -69,7 +68,7 @@ extTrigLitPos ps f = psPtCont ps (PutTrigger False)
         {_mdID = 0
         ,_mdExternalID1 = lsid
         ,_mdExternalID2 = fromJust $ _plMID tp
-        ,_mdUpdate = \md w -> if (_triggers w IM.! _mdExternalID2 md)
+        ,_mdUpdate = \md w -> if w ^?! triggers . ix (_mdExternalID2 md)
             then w & lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ V3 0 0.5 0
             else w & lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ V3 0.5 0 0
         }

src/Dodge/Render/ShapePicture.hs

@@ -33,6 +33,7 @@ import Picture
 import Sound.Data
 import Geometry.ConvexPoly
 import ShortShow
+import Polyhedra
 
 import StreamingHelp
 import qualified Data.IntMap.Strict as IM -- Lazy?
@@ -74,7 +75,30 @@ anyTargeting cfig w = (mempty,pictures $ IM.elems $ IM.mapMaybe f $ _crInv cr)
 drawCreature :: Creature -> SPic
 drawCreature cr = case _crType cr of
     Humanoid {} -> basicCrPict cr
-    DrawnCreature f -> f cr
+    Barreloid {} -> picAtCrPos1 (setDepth 20 $ pictures 
+        [ color orange $ circleSolid 10
+        , setDepth 0.049 . color (greyN 0.5) $ circleSolid 8
+        , color (greyN 0.5) $ circleSolid 8
+        ]) cr
+    Lampoid h -> picAtCrPosNoRot1 (lampCrPic h) cr
+    NonDrawnCreature -> mempty
+
+lampCrPic :: Float -> Picture
+lampCrPic h = pictures 
+    [ setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
+    , foldMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
+    ]
+  where
+    f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] BottomLayer polyNum
+    --DrawnCreature f -> f cr
+    --
+picAtCrPosNoRot1 :: Picture -> Creature -> SPic
+--{-# INLINE picAtCrPos #-}
+picAtCrPosNoRot1 thePic cr = (,) mempty $ uncurryV translate (_crPos cr) thePic
+
+picAtCrPos1 :: Picture -> Creature -> SPic
+--{-# INLINE picAtCrPos #-}
+picAtCrPos1 thePic cr = (,) mempty $ tranRot (_crPos cr) (_crDir cr) thePic
 
 shiftDraw :: (a -> Point2) -> (a -> Float) -> (a -> a -> SPic) -> a -> SPic
 shiftDraw fpos fdir fdraw x = uncurryV translateSPf (fpos x)

src/Dodge/Room/LongDoor.hs

@@ -48,8 +48,8 @@ twinSlowDoorRoom w h x = defaultRoom
         [ pContID (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id)
             $ \btid -> jsps0J (PutSlideDr (thedoor btid) thewall DoorObstacle 1 (V2 x 1) (V2 x h))
             $ ps0 (PutSlideDr (thedoor btid) thewall DoorObstacle 1 (V2 (-x) 1) (V2 (-x) h))
-            $ \did -> jps0' (PutLS (lsColPos (V3 0.75 0 0) (V3 0 (h-1) lampHeight)))
-            $ \lspl -> jsps0 $ PutProp $ addColorChange (fromJust $ _plMID lspl) did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight
+            $ \did -> jps0' (PutLS (lsColPos (V3 0.75 0 0) (V3 0 (h-1) lampheight)))
+            $ \lspl -> jsps0 $ PutProp $ addColorChange (fromJust $ _plMID lspl) did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampheight
         ]
     , _rmBound  = ps
     , _rmName   = "twinSlowDoorRoom"
@@ -65,7 +65,7 @@ twinSlowDoorRoom w h x = defaultRoom
             | otherwise = u & updatelscol 0.7
         updatelscol c = lightSources . ix lsid . lsParam . lsCol .~ c
     drmoving i w' = DoorHalfway == _drStatus (_doors w' IM.! i)
-    lampHeight = 41
+    lampheight = 41
     ps = 
         [rectNSWE h    0 (-w) w
         ,rectNSWE 20 (-h) (negate x) x