Data-ify creature drawing (partially)

src/Dodge/Creature.hs

@@ -59,15 +59,13 @@ spawnerCrit :: Creature
 spawnerCrit = defaultCreature
     { --_crUpdate = stateUpdate $ spawnerAI chaseCrit
      _crHP = 300
-    , _crPict = basicCrPict
     , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
     }
-    & crSkin . skinUpper .~ light4 blue
+    & crType . skinUpper .~ light4 blue
 
 miniGunCrit :: Creature
 miniGunCrit = defaultCreature
-    { _crPict = basicCrPict
+    { _crUpdate = defaultImpulsive [sentinelFireType (const shootTillEmpty)]
-    , _crUpdate = defaultImpulsive [sentinelFireType (const shootTillEmpty)]
 --    , _crInv = IM.fromList [(0,autoRifle & itConsumption . ammoLoaded .~ 1000)]
     , _crInv = IM.fromList [(0,miniGunX 3)]
 --    , _crInv = IM.fromList [(0,autoRifle)]
@@ -76,12 +74,10 @@ miniGunCrit = defaultCreature
     , _crHP = 500
     , _crMvType = defaultAimMvType
     }
-    & crSkin . skinUpper .~ light4 red
+    & crType . skinUpper .~ light4 red
 longCrit :: Creature
 longCrit = defaultCreature
-    { _crPict = basicCrPict
+    { _crUpdate = defaultImpulsive [sentinelFireType $ const shootTillEmpty]
---    , _crUpdate = stateUpdate sniperAI
-    , _crUpdate = defaultImpulsive [sentinelFireType $ const shootTillEmpty]
     , _crActionPlan = ActionPlan
         { _apImpulse    = []
         , _apAction     = []
@@ -92,12 +88,10 @@ longCrit = defaultCreature
     , _crRad = 10
     , _crHP = 150
     }
-    & crSkin . skinUpper .~ light4 red
+    & crType . skinUpper .~ light4 red
 multGunCrit :: Creature
 multGunCrit = defaultCreature
-    { _crPict = basicCrPict
+    { _crInv = IM.fromList [(0,volleyGun 4),(1,medkit 100)]
---    , _crUpdate = stateUpdate (twitchMissAI 300 350)
-    , _crInv = IM.fromList [(0,volleyGun 4),(1,medkit 100)]
     , _crRad = 10
     , _crHP = 300
     , _crUpdate = defaultImpulsive [sentinelExtraWatchUpdate
@@ -115,7 +109,7 @@ multGunCrit = defaultCreature
             ]
         ]
     }
-    & crSkin . skinUpper .~ light4 red
+    & crType . skinUpper .~ light4 red
   where
     drawwp = DoActionIfElse NoAction (const crIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction))
     reloadActions = 
@@ -136,7 +130,6 @@ startCr = defaultCreature
     , _crDir = pi/2
     , _crMvDir  = pi/2
     , _crID = 0
-    , _crPict = basicCrPict
     , _crUpdate = stateUpdate yourControl
     , _crRad = 10
     , _crMass = 10
@@ -147,7 +140,7 @@ startCr = defaultCreature
     , _crFaction = PlayerFaction
     , _crMvType = MvWalking yourDefaultSpeed
     }
-    & crSkin . skinUpper .~ light4 black
+    & crType . skinUpper .~ light4 black
 {- | Items you start with.  -}
 startInvList :: [Item]
 startInvList = [ ]

src/Dodge/Creature/ArmourChase.hs

@@ -10,7 +10,6 @@ import Dodge.Creature.ChaseCrit
 --import Dodge.Creature.ChainUpdates
 import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Perception
-import Dodge.Creature.Picture
 --import Dodge.Creature.Impulse
 import Dodge.Creature.Action
 import Dodge.Item.Equipment
@@ -36,7 +35,6 @@ flockArmourChaseCrit = defaultCreature
         ]
     , _crName = "armourChaseCrit"
     , _crHP = 300
-    , _crPict = basicCrPict
     , _crInv = IM.fromList 
         [(0,frontArmour)
         ,(1,medkit 200)

src/Dodge/Creature/AutoCrit.hs

@@ -3,7 +3,6 @@ module Dodge.Creature.AutoCrit
     ) where
 import Dodge.Data
 import Dodge.Default
-import Dodge.Creature.Picture
 import Dodge.Creature.Update
 import Dodge.Creature.SentinelAI
 --import Dodge.Creature.ChooseTarget
@@ -22,11 +21,10 @@ import Control.Lens
 
 autoCrit :: Creature
 autoCrit = defaultCreature
-    { _crPict = basicCrPict
+    { _crUpdate = defaultImpulsive [sentinelAI]
-    , _crUpdate = defaultImpulsive [sentinelAI]
     , _crInv = IM.fromList [(0,autoGun),(1,medkit 100)]
     , _crRad = 10
     , _crHP = 300
     , _crMvType = defaultAimMvType
     }
-    & crSkin . skinUpper .~ light4 red
+    & crType . skinUpper .~ light4 red

src/Dodge/Creature/ChaseCrit.hs

@@ -26,7 +26,6 @@ smallChaseCrit :: Creature
 smallChaseCrit = chaseCrit
     { _crHP = 1
     , _crRad = 4
-    , _crPict = basicCrPict
     , _crInv = IM.fromList [(0,medkit 200)]
     , _crCorpse = basicCrCorpse
     }
@@ -52,7 +51,6 @@ chaseCrit = defaultCreature
         ]
     , _crName = "chaseCrit"
     , _crHP = 150
-    , _crPict = basicCrPict
     , _crInv = IM.fromList [(0,medkit 200)]
     , _crMeleeCooldown = 0
     , _crFaction = ColorFaction green

src/Dodge/Creature/Inanimate.hs

@@ -31,7 +31,7 @@ barrel :: Creature
 barrel = defaultInanimate
     { _crUpdate = updateBarrel
     , _crHP = 500
-    , _crPict = picAtCrPos $ setDepth 20 $ pictures 
+    , _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
@@ -46,7 +46,7 @@ explosiveBarrel :: Creature
 explosiveBarrel = defaultInanimate
     { _crUpdate = updateExpBarrel
     , _crHP = 400
-    , _crPict = shapeAtCrPos
+    , _crType = DrawnCreature $ shapeAtCrPos
         . colorSH orange
         . upperPrismPoly 20
         $ polyCirc 4 10

src/Dodge/Creature/Lamp.hs

@@ -25,19 +25,14 @@ colorLamp
 colorLamp col h = defaultInanimate
     { _crUpdate = initialiseColorLamp col h
     , _crHP = 100
-    , _crPict = picAtCrPosNoRot (lampCrPic h)
+    , _crType = DrawnCreature $ picAtCrPosNoRot (lampCrPic h)
     , _crRad = 3
     , _crMass = 3
     }
 
 lamp :: Float -> Creature
-lamp h = defaultInanimate
+lamp = colorLamp 0.75
-    { _crUpdate = initialiseLamp h
+
-    , _crHP = 100
-    , _crPict = picAtCrPosNoRot (lampCrPic h)
-    , _crRad = 3
-    , _crMass = 3
-    }
 lampCrPic :: Float -> Picture
 lampCrPic h = pictures 
     [ setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
@@ -46,9 +41,6 @@ lampCrPic h = pictures
   where
     f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] BottomLayer polyNum
 
-initialiseLamp :: Float -> Creature -> World -> World
-initialiseLamp = initialiseColorLamp 0.75
-
 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/LauncherCrit.hs

@@ -4,7 +4,6 @@ module Dodge.Creature.LauncherCrit
     where
 import Dodge.Data
 import Dodge.Default
-import Dodge.Creature.Picture
 --import Dodge.Creature.ChainUpdates
 import Dodge.Creature.Test
 import Dodge.Creature.Volition
@@ -24,8 +23,7 @@ import Control.Lens
 
 launcherCrit :: Creature
 launcherCrit = defaultCreature
-    { _crPict = basicCrPict
+    { _crUpdate = defaultImpulsive
-    , _crUpdate = defaultImpulsive
         [ performActions
         , watchUpdateStrat
             [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFire])
@@ -44,7 +42,7 @@ launcherCrit = defaultCreature
     , _crState = defaultState
     , _crHP = 300
     }
-    & crSkin . skinUpper .~ light4 red
+    & crType . skinUpper .~ light4 red
 
 retreatFire :: Action
 retreatFire = ImpulsesList ( [ UseItem ] : replicate 20 [ Turn 0.16 ])

src/Dodge/Creature/LtAutoCrit.hs

@@ -3,7 +3,6 @@ module Dodge.Creature.LtAutoCrit
     ) where
 import Dodge.Data
 import Dodge.Default
-import Dodge.Creature.Picture
 import Dodge.Creature.Update
 import Dodge.Creature.Action
 import Dodge.Creature.Test
@@ -22,8 +21,7 @@ import Control.Lens
 
 ltAutoCrit :: Creature
 ltAutoCrit = defaultCreature
-    { _crPict = basicCrPict
+    { _crUpdate = defaultImpulsive
-    , _crUpdate = defaultImpulsive
         [ performActions
         , watchUpdateStrat
             [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) 
@@ -47,7 +45,7 @@ ltAutoCrit = defaultCreature
     , _crRad = 10
     , _crHP = 500
     }
-    & crSkin . skinUpper .~ light4 red
+    & crType . skinUpper .~ light4 red
 
 chooseMovement :: Creature -> World -> Action
 chooseMovement cr w 

src/Dodge/Creature/Picture.hs

@@ -47,7 +47,7 @@ basicCrShape cr
         , rotmdir $ colorSH (_skinLower cskin) $ feet cr
         ]
   where 
-    cskin = _crSkin cr
+    cskin = _crType cr
     crsize = 0.1 * _crRad cr
     tr = uncurryV translateSHf (_crPos cr)
     rotdir = rotateSH (_crDir cr)
@@ -235,7 +235,7 @@ basicCrCorpse cr cp = noPic . tr . scaleSH (V3 crsize crsize crsize) $ mconcat
         , rotdir . rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
         ]
   where 
-    cskin = _crSkin cr
+    cskin = _crType cr -- this should be fixed
     crsize = 0.1 * _crRad cr
     tr = uncurryV translateSHf (_cpPos cp)
     rotdir = rotateSH (_cpDir cp)

src/Dodge/Creature/PistolCrit.hs

@@ -3,7 +3,6 @@ module Dodge.Creature.PistolCrit
     ) where
 import Dodge.Data
 import Dodge.Default
-import Dodge.Creature.Picture
 import Dodge.Creature.Update
 import Dodge.Creature.Test
 import Dodge.Creature.Action
@@ -24,8 +23,7 @@ import Control.Lens
 
 pistolCrit :: Creature
 pistolCrit = defaultCreature
-    { _crPict = basicCrPict
+    { _crUpdate =  defaultImpulsive
-    , _crUpdate =  defaultImpulsive
         [ performActions
         , watchUpdateStrat
               [ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0) 
@@ -44,7 +42,7 @@ pistolCrit = defaultCreature
     , _crRad = 10
     , _crHP = 500
     }
-    & crSkin . skinUpper .~ light4 red
+    & crType . skinUpper .~ light4 red
 chooseMovement :: Creature -> World -> Action
 chooseMovement cr w = chooseMovement' cr w
         `DoActionThen`

src/Dodge/Creature/SpreadGunCrit.hs

@@ -3,7 +3,6 @@ module Dodge.Creature.SpreadGunCrit
     ) where
 import Dodge.Data
 import Dodge.Default
-import Dodge.Creature.Picture
 import Dodge.Creature.Update
 import Dodge.Creature.Test
 import Dodge.Creature.Action
@@ -24,8 +23,7 @@ import Control.Lens
 
 spreadGunCrit :: Creature
 spreadGunCrit = defaultCreature
-    { _crPict = basicCrPict
+    { _crUpdate = defaultImpulsive
-    , _crUpdate = defaultImpulsive
         [performActions
         ,watchUpdateStrat
           [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) 
@@ -49,7 +47,7 @@ spreadGunCrit = defaultCreature
     , _crRad = 10
     , _crHP = 500
     }
-    & crSkin . skinUpper .~ light4 red
+    & crType . skinUpper .~ light4 red
 
 chooseMovement :: Creature -> World -> Action
 chooseMovement cr w 

src/Dodge/Creature/State.hs

@@ -80,7 +80,7 @@ checkDeath cr w
   where
     removecr
         | _crID cr == 0 = (creatures . ix (_crID cr) . crUpdate .~ const id)
-            . (creatures . ix (_crID cr) . crPict .~ const mempty)
+            . (creatures . ix (_crID cr) . crType .~ DrawnCreature (const mempty))
             . (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/Creature/SwarmCrit.hs

@@ -30,12 +30,11 @@ swarmCrit = defaultCreature
     , _crHP = 1
     , _crRad = 2
     , _crMass = 2
-    , _crPict = basicCrPict
     , _crCorpse = basicCrCorpse
     , _crFaction = ColorFaction yellow
     , _crMeleeCooldown = 0
     }
-    & crSkin . skinUpper .~ light4 yellow
+    & crType . skinUpper .~ light4 yellow
 
 --swarmCritMoveFunc :: Creature -> Point2 -> Creature -> Point2
 --swarmCritMoveFunc tcr cenp cr 

src/Dodge/Data.hs

@@ -356,6 +356,13 @@ data TempLightSource = TLS
     , _tlsUpdate    :: World -> TempLightSource -> Maybe TempLightSource
     , _tlsTime      :: !Int
     }
+data CreatureType
+    = Humanoid
+        { _skinHead     :: Color
+        , _skinUpper    :: Color
+        , _skinLower    :: Color
+        }
+    | DrawnCreature { _cdDraw :: Creature -> SPic }
 data Creature = Creature
     { _crPos            :: Point2
     , _crOldPos         :: Point2
@@ -364,9 +371,8 @@ data Creature = Creature
     , _crOldDir         :: Float
     , _crMvDir          :: Float
     , _crTwist          :: Float
+    , _crType           :: CreatureType
     , _crID             :: Int
-    , _crPict           :: Creature -> SPic
-    , _crSkin           :: CreatureSkin
     , _crUpdate         :: Creature -> World -> World
     , _crRad            :: Float
     , _crMass           :: Float
@@ -398,11 +404,6 @@ data Creature = Creature
     , _crStatistics     :: CreatureStatistics
     , _crCamouflage     :: CamouflageStatus
     }
-data CreatureSkin = CreatureSkin
-    { _skinHead     :: Color
-    , _skinUpper    :: Color
-    , _skinLower    :: Color
-    }
 data CamouflageStatus
     = FullyVisible
     | Invisible
@@ -1597,7 +1598,7 @@ makeLenses ''EquipParams
 makeLenses ''TerminalCommand
 makeLenses ''TerminalInput
 makeLenses ''GenParams
-makeLenses ''CreatureSkin
+makeLenses ''CreatureType
 makeLenses ''Corpse
 ----- ROOM LENSES
 

src/Dodge/Default.hs

@@ -38,8 +38,8 @@ defaultCreature = Creature
     , _crMvDir  = 0
     , _crTwist  = 0
     , _crID     = 1
-    , _crPict   = basicCrPict
+--    , _crPict   = basicCrPict
-    , _crSkin = defaultCreatureSkin
+    , _crType = defaultCreatureSkin
     , _crUpdate = const id
     , _crRad    = 10
     , _crMass   = 10
@@ -75,8 +75,8 @@ defaultCreature = Creature
     , _crStatistics = CreatureStatistics 10 10 10
     , _crCamouflage = FullyVisible
     }
-defaultCreatureSkin :: CreatureSkin
+defaultCreatureSkin :: CreatureType
-defaultCreatureSkin = CreatureSkin (greyN 0.9) (light4 green) (greyN 0.3)
+defaultCreatureSkin = Humanoid (greyN 0.9) (light4 green) (greyN 0.3)
 
 defaultInanimate :: Creature
 defaultInanimate = defaultCreature & crActionPlan .~ Inanimate

src/Dodge/Default/Weapon.hs

@@ -120,7 +120,8 @@ defaultWeapon = defaultItem
         ]
 
 defaultBulletWeapon :: Item
-defaultBulletWeapon = defaultWeapon & itConsumption .~ defaultBulletLoadable 
+defaultBulletWeapon = defaultWeapon 
+    & itConsumption .~ defaultBulletLoadable 
     & itUse .~ ruseAmmoParams
 
 defaultItemValue :: ItemValue

src/Dodge/Placement/Instance/Turret.hs

@@ -5,7 +5,6 @@ import Dodge.Data
 import Dodge.Creature.State
 import Dodge.Creature.Damage
 import Dodge.Creature.Impulse
-import Dodge.Creature.Picture
 import Dodge.LevelGen.Data
 import Dodge.Default
 import Dodge.Movement.Turn
@@ -75,7 +74,6 @@ updateTurret rotSpeed mc w
                 & crOldPos .~ mcpos
                 & crRad    .~ 1
                 & crDir .~ mcdir
-                & crPict .~ drawCrEquipment
                 & crUpdate .~ stateUpdate followThenClearImpulses
                 & crStance . posture .~ Aiming
                 & crApplyDamage .~ applyNoDamage

src/Dodge/Prop/Gib.hs

@@ -53,7 +53,7 @@ addCrGibs cr w = case damageDirection $ _csDamage $ _crState cr of
         & addGibsAtDir d 13 20 (_skinUpper skin) cpos
         & addGibAtDir d 25 (_skinHead skin) cpos
   where
-    skin = _crSkin cr
+    skin = _crType cr -- this should be cleaned up
     cpos = _crPos cr
 
 addGibsAt :: Float -> Float -> Color -> Point2 -> World -> World

src/Dodge/Render/ShapePicture.hs

@@ -2,6 +2,7 @@ module Dodge.Render.ShapePicture
     ( worldSPic
     ) where
 import Dodge.Creature.Picture.Awareness
+import Dodge.Creature.Picture
 import Dodge.Particle.Draw
 import Dodge.RadarBlip
 import Dodge.Flare
@@ -54,7 +55,7 @@ worldSPic cfig w
     <> foldup (shiftDraw _blPos _blDir _blDraw) (filtOn' _blPos _blocks)           
     <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _shapes)   
     <> foldup (dbArg _cpPict) (filtOn' _cpPos _corpses)                            
-    <> foldup (dbArg _crPict) (filtOn' _crPos _creatures)                          
+    <> foldup drawCreature (filtOn' _crPos _creatures)                          
     <> foldup floorItemSPic (filtOn' _flItPos _floorItems)                         
     <> foldup btSPic (filtOn' _btPos _buttons)                                     
     <> foldup mcSPic (filtOn' _mcPos _machines)                                    
@@ -71,6 +72,11 @@ anyTargeting cfig w = (mempty,pictures $ IM.elems $ IM.mapMaybe f $ _crInv cr)
     cr = you w
     f it = fmap (\g -> g it cr cfig w) (it ^? itTargeting . tgDraw)
 
+drawCreature :: Creature -> SPic
+drawCreature cr = case _crType cr of
+    Humanoid {} -> basicCrPict cr
+    DrawnCreature f -> f cr
+
 shiftDraw :: (a -> Point2) -> (a -> Float) -> (a -> a -> SPic) -> a -> SPic
 shiftDraw fpos fdir fdraw x = uncurryV translateSPf (fpos x)
     . rotateSP (fdir x)

src/Shader/Poke.hs

@@ -118,7 +118,7 @@ pokeShapeObj
     -> (Int,Int,Int)
     -> ShapeObj
     -> IO (Int,Int,Int)
---{-# INLINE pokeShapeObj #-}
+{-# INLINE pokeShapeObj #-}
 pokeShapeObj ptr iptr ieptr counts (ShapeObj shtype shVerts) = case shtype of
     TopPrism size -> pokeTopPrism (size - 2) ptr iptr ieptr counts (S.each shVerts)
 
@@ -127,7 +127,7 @@ pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort
     -> (Int,Int,Int)
     -> Stream (Of ShapeV) IO ()
     -> IO (Int,Int,Int)
---{-# INLINE pokeTopPrism #-}
+{-# INLINE pokeTopPrism #-}
 pokeTopPrism size ptr iptr ieptr (nv,nshapeindices,nedgeindices) svs = do
     nv' <- S.foldM_ (pokeJustV ptr) (return nv) return svs
     nshapeindices' <- UV.foldM' (pokeTopPrismIndex nv iptr) nshapeindices