70 lines
2.2 KiB
Haskell
70 lines
2.2 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
|
|
-> Maybe Int
|
|
-- -> (Machine -> World -> World)
|
|
-> PlacementSpot -> Placement
|
|
damageSensor dt wdth mtrid -- 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
|
|
& mcMounts . at ObTrigger .~ mtrid
|
|
)
|
|
{ _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)
|
|
-> Maybe Int
|
|
-> 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
|