133 lines
3.7 KiB
Haskell
133 lines
3.7 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
{-
|
|
Inanimate objects such as lamps, barrels, etc
|
|
-}
|
|
module Dodge.Creature.Inanimate
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Creature.Picture
|
|
--import Dodge.Creature.Stance.Data
|
|
import Dodge.Creature.State.Data
|
|
import Dodge.Picture.Layer
|
|
import Dodge.Default
|
|
import Dodge.Creature.State
|
|
import Dodge.LightSources.Lamp
|
|
import Dodge.WorldEvent.Flash
|
|
import Dodge.WorldEvent.Sound
|
|
import Dodge.Creature.Update
|
|
import Picture
|
|
import qualified IntMapHelp as IM
|
|
import Geometry
|
|
--import Geometry.Data
|
|
import Geometry.Vector3D
|
|
import Polyhedra
|
|
import Shape
|
|
|
|
import Control.Lens
|
|
import qualified Control.Foldl as L
|
|
--import qualified Data.Vector.Fusion.Stream.Monadic as VS
|
|
import Data.Monoid
|
|
|
|
defaultInanimate :: Creature
|
|
defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
|
|
|
|
colorLamp
|
|
:: Point3 -- color of lamp
|
|
-> Float -- height of lamp
|
|
-> Creature
|
|
colorLamp col h = defaultInanimate
|
|
{ _crUpdate = initialiseColorLamp col h
|
|
, _crHP = 100
|
|
, _crPict = picAtCrPosNoRot (lampCrPic h)
|
|
, _crRad = 3
|
|
, _crMass = 3
|
|
}
|
|
|
|
lamp :: Float -> Creature
|
|
lamp h = defaultInanimate
|
|
{ _crUpdate = initialiseLamp h
|
|
, _crHP = 100
|
|
, _crPict = picAtCrPosNoRot (lampCrPic h)
|
|
, _crRad = 3
|
|
, _crMass = 3
|
|
}
|
|
-- it is not clear that any of the attempts with Foldl help at all here
|
|
lampCrPic :: Float -> Picture
|
|
lampCrPic h = pictures
|
|
[ setLayer 1 (setDepth h . color white $ circleSolid 3)
|
|
, concatMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
|
|
]
|
|
where
|
|
f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] 0 polyNum
|
|
|
|
lTriFold :: a -> a -> L.Fold a [a]
|
|
lTriFold s x = L.Fold (f s) (x,[]) snd
|
|
where
|
|
f s' (x1,l) x2 = (x2,s':x1:x2:l)
|
|
|
|
preTriFold :: (a -> b) -> [a] -> [b]
|
|
preTriFold f (s:x:xs) = L.fold (L.premap f $ lTriFold (f s) (f x)) xs
|
|
preTriFold _ _ = []
|
|
|
|
polyToTriFold :: [a] -> [a]
|
|
polyToTriFold (s:x:xs) = L.fold (lTriFold s x) xs
|
|
polyToTriFold _ = []
|
|
|
|
initialiseLamp :: Float -> CRUpdate
|
|
initialiseLamp = initialiseColorLamp 0.75
|
|
|
|
initialiseColorLamp :: Point3 -> Float -> CRUpdate
|
|
initialiseColorLamp col h cr _ = ( Endo addLS , Just $ cr & crUpdate .~ updateLamp h i)
|
|
where
|
|
i = _crID cr
|
|
addLS w = w
|
|
& lightSources %~ IM.insert lsid (colorLightAt col (V3 x y h) lsid)
|
|
& creatures . ix i . crUpdate .~ updateLamp h lsid
|
|
where
|
|
lsid = IM.newKey $ _lightSources w
|
|
(V2 x y) = _crPos cr
|
|
|
|
updateLamp :: Float -> Int -> CRUpdate
|
|
updateLamp h i = unrandUpdate handleLS internalUpdate
|
|
where
|
|
handleLS cr w
|
|
| _crHP cr < 0 = explosionFlashAt cPos
|
|
$ mkSoundBreakGlass cPos w & lightSources %~ IM.delete i
|
|
| otherwise = w & lightSources . ix i . lsPos .~ f cPos
|
|
where
|
|
cPos = _crPos cr
|
|
f (V2 x y) = V3 x y h
|
|
internalUpdate cr
|
|
| _crHP cr < 0 = Nothing
|
|
| otherwise = Just $ doDamage cr
|
|
|
|
barrel :: Creature
|
|
barrel = defaultInanimate
|
|
{ _crUpdate = updateBarrel
|
|
, _crHP = 500
|
|
, _crPict = picAtCrPos $ onLayer CrLayer $ pictures
|
|
[ color orange $ circleSolid 10
|
|
, setDepth 0.049 . color (greyN 0.5) $ circleSolid 8
|
|
, color (greyN 0.5) $ circleSolid 8
|
|
]
|
|
, _crState = defaultState
|
|
{_crSpState = Barrel []
|
|
}
|
|
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
|
|
}
|
|
|
|
explosiveBarrel :: Creature
|
|
explosiveBarrel = defaultInanimate
|
|
{ _crUpdate = updateExpBarrel
|
|
, _crHP = 400
|
|
, _crPict = shapeAtCrPos
|
|
. colorSH orange
|
|
. upperPrismPoly 20
|
|
$ polyCirc 4 10
|
|
, _crState = defaultState
|
|
{_crSpState = Barrel []
|
|
}
|
|
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
|
|
,_crApplyDamage = \_ c -> (id, c)
|
|
}
|