62 lines
2.1 KiB
Haskell
62 lines
2.1 KiB
Haskell
module Dodge.Placement.Instance.Analyser (
|
|
analyser,
|
|
) where
|
|
|
|
import Color
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Default
|
|
import Dodge.Placement.Instance
|
|
import Dodge.Terminal
|
|
import LensHelp
|
|
|
|
analyser ::
|
|
ProximityRequirement ->
|
|
PlacementSpot ->
|
|
PlacementSpot ->
|
|
Placement
|
|
analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp ->
|
|
Just $
|
|
plSpot .~ psmc $
|
|
putTerminal
|
|
(themachine & mcMounts . at ObTrigger .~ _plMID tp)
|
|
tparams -- (linksensortotrigger tp)
|
|
where
|
|
tparams = basicTerminal & tmScrollCommands .:~ sensorCommand
|
|
-- linksensortotrigger tp _ mc
|
|
-- = triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)
|
|
themachine =
|
|
defaultMachine & mcColor .~ aquamarine
|
|
-- & mcUpdate .~ mcProximitySensorUpdate
|
|
& mcType .~ McTerminal
|
|
& mcHP .~ 100
|
|
& mcType .~ McSensor (defaultProximitySensor{_proxRequirement = proxreq})
|
|
|
|
--this can probably be deleted
|
|
--mcProximitySensorUpdate :: Machine -> World -> World
|
|
--mcProximitySensorUpdate mc w = case
|
|
-- (_proxStatus sens
|
|
-- , _sensToggle sens
|
|
-- , mcProxTest mc w
|
|
-- , dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of
|
|
-- (_,True,_,_) -> w
|
|
-- (_,False,True,True) -> w
|
|
-- & machines . ix (_mcID mc) . mcSensor . sensToggle .~ True
|
|
-- & playsound dedaS
|
|
-- & machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
|
|
-- (NotClose,_,False,True) -> w & playsound dedumS
|
|
-- & machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
|
|
-- (_,_,_,False) -> w & machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose
|
|
-- _ -> w
|
|
-- where
|
|
-- playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
|
|
-- ycr = you w
|
|
-- sens = _mcSensor mc
|
|
--
|
|
--mcProxTest :: Machine -> World -> Bool
|
|
--mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
|
|
-- Just (RequireHealth x) -> _crHP cr >= x
|
|
-- Just (RequireEquipment ct) -> any (\itm -> _iyBase (_itType itm) == ct) (_crInv cr)
|
|
-- _ -> False
|
|
-- where
|
|
-- cr = you w
|