This commit is contained in:
2022-07-14 21:12:51 +01:00
parent 5463328d41
commit 893a3d5f17
5 changed files with 11 additions and 61 deletions
-11
View File
@@ -17,7 +17,6 @@ import Dodge.Default.LightSource
import Dodge.Default.Item
import Dodge.Data
import Dodge.SoundLogic
import Dodge.Wall.Delete
import Dodge.Creature.Damage
import Dodge.Creature.Picture
import Geometry
@@ -193,17 +192,7 @@ defaultMachine = Machine
, _mcName = ""
, _mcMounts = mempty
, _mcCloseSound = Nothing
-- , _mcTriggerCond = const True
}
defaultMachineUpdate :: Machine -> World -> World
defaultMachineUpdate mc
| _mcHP mc < 1 = (machines %~ IM.delete mcid)
. deleteWallIDs (_mcWallIDs mc)
| otherwise = machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) )
where
dams = sum $ map _dmAmount $ _mcDamage mc
mcid = _mcID mc
defaultDrawButton :: Color -> Button -> SPic
defaultDrawButton col bt =
( translateSHz 15 . colorSH col $ upperPrismPoly 5 buttonGeometry
+1 -2
View File
@@ -113,10 +113,9 @@ mcTriggerVal mc = case mc ^. mcSensor of
s@ProximitySensor{} -> s ^? sensToggle
s@SensorToggleAmount{} -> Just $ (_sensAmount s) > 900
mcPlaySound :: Machine -> World -> World
mcPlaySound mc w = case _mcCloseSound mc of
Just sid | d < 200 -> soundContinueVol (1-0.005*d) (MachineSound mid) (_mcPos mc) sid (Just 2) w
Just sid | d < 200 -> soundContinueVol (1-0.01*max 0 (d-100)) (MachineSound mid) (_mcPos mc) sid (Just 2) w
_ -> w
where
d = dist (_crPos $ you w) (_mcPos mc)
+7 -34
View File
@@ -14,52 +14,25 @@ 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)
damageSensor dt wdth mtrid 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]
}
$ \gw -> (,) gw $ PutMachine (reverse $ square wdth) $ defaultMachine
& mcColor .~ yellow
& mcMounts . at ObTrigger .~ mtrid
& mcDraw .~ sensorSPic wdth (_sensorCoding (_genParams gw) M.! dt)
& 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
+2 -7
View File
@@ -10,6 +10,7 @@ import Dodge.Room.Door
import Dodge.Room.Corridor
import Dodge.Room.Link
import Dodge.Room.Ngon
import Dodge.Room.SensorDoor
--import Dodge.Room.Foreground
import Dodge.Wire
import Dodge.Placement.Instance
@@ -42,13 +43,7 @@ lightSensInsideDoor outplid rm = rm
& rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 10 (atFstLnkOutShiftInward 100)) outplid]
lasSensLightAboveDoor :: Float -> PlacementSpot -> Placement
lasSensLightAboveDoor wth ps = extTrigLitPos
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
( \tp -> Just $ lightSensor wth (_plMID tp) --(upf $ fromJust $ _plMID tp)
ps )
where
upf trid mc w | _sensAmount (_mcSensor mc) > 900 = w & triggers . ix trid .~ const True
| otherwise = w
lasSensLightAboveDoor = sensAboveDoor LASERING
lightSensByDoor :: Int -> Room -> Room
lightSensByDoor outplid rm = rm
+1 -7
View File
@@ -21,8 +21,6 @@ import LensHelp
import RandomHelp
import qualified Data.Set as S
import Data.Maybe
--import Data.Tree
-- TODO fix case where the sensor created by sensInsideDoor blocks another door
-- for roomRectAutoLinks-- make the locked door a center door?
@@ -60,11 +58,7 @@ sensorRoomRunPast dt n = do
sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement
sensAboveDoor sensetype wth ps = extTrigLitPos
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
( \tp -> Just $ damageSensor sensetype wth (_plMID tp) --(upf $ fromJust $ _plMID tp)
ps )
where
upf trid mc w | _sensAmount (_mcSensor mc) > 900 = w & triggers . ix trid .~ const True
| otherwise = w
( \tp -> Just $ damageSensor sensetype wth (_plMID tp) ps )
sensInsideDoor :: DamageType -> Int -> Room -> Room
sensInsideDoor senseType outplid rm = rm