Files
loop/src/Dodge/Creature/Lamp.hs
T

64 lines
1.7 KiB
Haskell

module Dodge.Creature.Lamp
( lamp
, colorLamp
) where
import Dodge.Data
import Dodge.Material
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
-> Creature
colorLamp col h = defaultInanimate
{ _crUpdate = initialiseColorLamp col h
, _crHP = 100
, _crType = DrawnCreature $ picAtCrPosNoRot (lampCrPic h)
, _crRad = 3
, _crMass = 3
}
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
& creatures . ix (_crID cr) . crUpdate .~ updateLamp h lsid
where
lsid = IM.newKey $ _lightSources w
updateLamp :: Float -> Int -> Creature -> World -> World
updateLamp h i cr w
| _crHP cr < 0 = w
& explosionFlashAt cpos
& originsIDsAt [MaterialSound Glass n | n <- [0,1,2]] (destroyMatS Glass) cpos
& lightSources . at i .~ Nothing
& creatures . at cid .~ Nothing
| otherwise = w
& lightSources . ix i . lsParam . lsPos .~ addZ h cpos
& doDamage cr
where
cpos = _crPos cr
cid = _crID cr