40 lines
1.4 KiB
Haskell
40 lines
1.4 KiB
Haskell
module Dodge.Lampoid (updateLampoid) where
|
|
|
|
import Linear
|
|
import Dodge.Creature.State
|
|
import Dodge.Data.World
|
|
import Dodge.LightSource
|
|
import Dodge.Material.Sound
|
|
import Dodge.WorldEvent.Sound
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
|
|
updateLampoid :: Creature -> World -> World
|
|
updateLampoid cr w = case cr ^?! crType . lampLSID of
|
|
Nothing ->
|
|
let i = IM.newKey (w ^. cWorld . lWorld . lightSources)
|
|
in w & cWorld . lWorld . lightSources . at i ?~ lsColPosID lcol (addZ h cpos) i
|
|
& cWorld . lWorld . creatures . ix (_crID cr) . crType . lampLSID ?~ i
|
|
Just i
|
|
| cr ^?! crHP . _HP < 0 ->
|
|
w
|
|
& cWorld . lWorld . worldEvents
|
|
.:~ MakeTempLight
|
|
(LSParam (addZ 20 cpos) 150 1)
|
|
20
|
|
& soundOriginsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]]
|
|
(destroyMatS Glass) cpos
|
|
& cWorld . lWorld . lightSources . at i .~ Nothing
|
|
& cWorld . lWorld . creatures . at cid .~ Nothing
|
|
| otherwise ->
|
|
w
|
|
& cWorld . lWorld . lightSources . ix i . lsParam . lsPos .~ addZ h cpos
|
|
& doDamage (cr ^. crID)
|
|
where
|
|
cpos = cr ^. crPos . _xy
|
|
cid = _crID cr
|
|
crtype = _crType cr
|
|
h = _lampHeight crtype
|
|
lcol = _lampColor crtype
|