62 lines
2.0 KiB
Haskell
62 lines
2.0 KiB
Haskell
module Dodge.Placement.Instance.Sensor
|
|
( lightSensor
|
|
, damageSensor
|
|
) where
|
|
import Color
|
|
import Dodge.LightSource
|
|
import Dodge.Data
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Default
|
|
import Dodge.Placement.TopDecoration
|
|
import Geometry
|
|
import ShapePicture
|
|
import Shape
|
|
|
|
import qualified Data.Map.Strict as M
|
|
import Control.Lens
|
|
import Data.Either
|
|
|
|
damageSensor
|
|
:: DamageType -- Left gets sensed, Right does damage
|
|
-> Float
|
|
-> (Machine -> World -> World)
|
|
-> PlacementSpot -> Placement
|
|
damageSensor dt wdth upf ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1)
|
|
$ \lsid -> Just $ spNoID ps $ PutUsingGenParams
|
|
$ \gw -> (,) gw $ PutMachine (reverse $ square wdth) (defaultMachine & mcColor .~ yellow)
|
|
{ _mcDraw = sensorSPic wdth $ _sensorCoding (_genParams gw) M.! dt
|
|
, _mcUpdate = \mc -> upf mc . sensorUpdate dt mc
|
|
, _mcSensor = SensorToggleAmount False 0
|
|
, _mcLSs = [lsid]
|
|
}
|
|
|
|
lightSensor :: Float -> (Machine -> World -> World) -> PlacementSpot -> Placement
|
|
lightSensor = damageSensor LASERING
|
|
|
|
sensorUpdate :: DamageType -> Machine -> World -> World
|
|
sensorUpdate damF mc w = w & machines . ix mcid %~ upmc
|
|
& lightSources . ix lsid %~ upls
|
|
where
|
|
upmc = ( mcSensor . sensAmount %~ \x' -> min 1000 (max 0 (x' - 5 + newSense)) )
|
|
. ( mcHP -~ sum dam )
|
|
. (mcDamage .~ [])
|
|
x = _sensAmount $ _mcSensor mc
|
|
mcid = _mcID mc
|
|
lsid = head (_mcLSs mc)
|
|
(senseData,dam) = partitionEithers $ map (damageUsing damF) $ _mcDamage mc
|
|
newSense = sum senseData
|
|
ni = fromIntegral x / 1000
|
|
upls = lsParam . lsCol .~ V3 ni ni ni
|
|
|
|
damageUsing :: DamageType -> Damage -> Either Int Int
|
|
damageUsing dt dm
|
|
| _dmType dm == dt = Left $ _dmAmount dm
|
|
| otherwise = Right 0
|
|
|
|
sensorSPic :: Float -> (PaletteColor,DecorationShape) -> Machine -> SPic
|
|
sensorSPic wdth (pc,ds) mc = noPic
|
|
$ colorSH (_mcColor mc) (upperPrismPoly 25 (square wdth))
|
|
<> decorationToShape ds wdth wdth 25 col col
|
|
where
|
|
col = paletteToColor pc
|