diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 751f11cf9..76aeb57b3 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -1020,11 +1020,16 @@ data TerminalToggle = TerminalToggle { _ttTriggerID :: Int , _ttDeathEffect :: (World -> Bool) -> (World -> Bool) } +--data DamageApplication +-- = ApplyNoDamage +-- | DefaultApplyDamage + data Machine = Machine { _mcID :: Int , _mcWallIDs :: IS.IntSet - , _mcUpdate :: Machine -> World -> World +-- , _mcUpdate :: Machine -> World -> World , _mcDraw :: Machine -> SPic +-- , _mcDamageApplication :: DamageApplication , _mcPos :: Point2 , _mcDir :: Float , _mcColor :: Color @@ -1035,7 +1040,8 @@ data Machine = Machine , _mcType :: MachineType , _mcMounts :: M.Map Object Int , _mcName :: String - , _mcCloseSound :: Maybe SoundID +-- , _mcTriggerCond :: Machine -> Bool + , _mcCloseSound :: Maybe SoundID -- , _mcTermMID :: Maybe Int } data Sensor = NoSensor diff --git a/src/Dodge/Data/Object.hs b/src/Dodge/Data/Object.hs index 546ac182e..5486e0d44 100644 --- a/src/Dodge/Data/Object.hs +++ b/src/Dodge/Data/Object.hs @@ -10,4 +10,5 @@ data Object | ObForegroundShape | ObLightSource | ObProp + | ObTrigger deriving (Eq,Show,Ord,Read,Enum,Bounded) diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 105dc0911..023bce060 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -180,7 +180,7 @@ defaultMachine :: Machine defaultMachine = Machine { _mcID = 0 , _mcWallIDs = mempty - , _mcUpdate = defaultMachineUpdate +-- , _mcUpdate = defaultMachineUpdate , _mcDraw = const mempty , _mcColor = white , _mcPos = V2 0 0 @@ -193,6 +193,7 @@ defaultMachine = Machine , _mcName = "" , _mcMounts = mempty , _mcCloseSound = Nothing +-- , _mcTriggerCond = const True } defaultMachineUpdate :: Machine -> World -> World defaultMachineUpdate mc diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index ac24849d9..500261256 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -45,7 +45,7 @@ initialAnoTree = OnwardList -- , AnRoom $ tanksRoom [] [] -- , AnRoom $ roomCCrits 0 -- , AnRoom $ return airlock0 - , AnRoom slowDoorRoom +-- , AnRoom slowDoorRoom -- , AnRoom $ roomCCrits 10 -- , AnTree firstBreather -- , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward @@ -55,10 +55,10 @@ initialAnoTree = OnwardList --extraAnoList = ---- , (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor]) -- [ AnRoom $ roomCCrits 10 - , AnRoom $ roomCCrits 10 - , AnTree $ tToBTree "spawners" <$> spawnerRoom - , AnRoom pistolerRoom - , AnRoom doubleCorridorBarrels +-- , AnRoom $ roomCCrits 10 +-- , AnTree $ tToBTree "spawners" <$> spawnerRoom +-- , AnRoom pistolerRoom +-- , AnRoom doubleCorridorBarrels , IntAnno $ PassthroughLockKeyLists [(sensorRoomRunPast ELECTRICAL, takeOne [CRAFT STATICMODULE,HELD SPARKGUN] )] itemRooms , IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms diff --git a/src/Dodge/Item/Draw/SPic.hs b/src/Dodge/Item/Draw/SPic.hs index 616ffd96d..364138b87 100644 --- a/src/Dodge/Item/Draw/SPic.hs +++ b/src/Dodge/Item/Draw/SPic.hs @@ -24,7 +24,7 @@ itemSPic it = foldMap (modulesSPic it) (_iyModules $ _itType it) $ case it ^. it KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic) -- MEDKIT _ -> defSPic - CRAFT _ -> defSPic + CRAFT _ -> flatShieldEquipSPic equipItemSPic :: EquipItemType -> Item -> SPic equipItemSPic et _ = case et of diff --git a/src/Dodge/Machine/Update.hs b/src/Dodge/Machine/Update.hs index ca7de4889..154f4c04f 100644 --- a/src/Dodge/Machine/Update.hs +++ b/src/Dodge/Machine/Update.hs @@ -26,6 +26,7 @@ updateMachine mc | _mcHP mc < 1 = destroyMachine mc | otherwise = mcApplyDamage (_mcDamage mc) mc . mcPlaySound mc + . mcSensorTriggerUpdate mc . mcTurretUpdate mc . mcSensorUpdate mc @@ -100,6 +101,19 @@ updateTurret rotSpeed mc w | closeFireAngle = machines . ix mcid . mcType . tuFireTime .~ 20 | otherwise = machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1) +mcSensorTriggerUpdate :: Machine -> World -> World +mcSensorTriggerUpdate mc = fromMaybe id $ do + trid <- mc ^? mcMounts . ix ObTrigger + bval <- mcTriggerVal mc + return $ triggers . ix trid .~ const bval + +mcTriggerVal :: Machine -> Maybe Bool +mcTriggerVal mc = case mc ^. mcSensor of + NoSensor -> Nothing + 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 @@ -109,8 +123,10 @@ mcPlaySound mc w = case _mcCloseSound mc of mid = _mcID mc mcApplyDamage :: [Damage] -> Machine -> World -> World -mcApplyDamage ds mc = machines . ix (_mcID mc) %~ - ( (mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)) ) +mcApplyDamage ds mc = case _mcSensor mc of + NoSensor -> machines . ix (_mcID mc) %~ + ( (mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)) ) + _ -> id mcSensorUpdate :: Machine -> World -> World mcSensorUpdate mc w = case _mcSensor mc of diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index f3cbf1ecf..fc3b7f041 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -4,7 +4,7 @@ module Dodge.Placement.Instance.Analyser --import Dodge.LevelGen.Data --import Dodge.PlacementSpot import Dodge.Data -import Dodge.Base.You +--import Dodge.Base.You import Dodge.Default import Dodge.Terminal --import Dodge.Tree @@ -18,13 +18,13 @@ import Dodge.Terminal --import Dodge.Room.RoadBlock import Dodge.Placement.Instance --import Dodge.Placement.Shift -import Dodge.SoundLogic +--import Dodge.SoundLogic --import Dodge.Default.Room --import Dodge.Item.Weapon.BulletGuns --import Dodge.Item.Weapon.Utility --import Dodge.LevelGen.Data --import Geometry.Data -import Geometry +--import Geometry --import Padding import Color --import Shape @@ -33,7 +33,7 @@ import LensHelp --import Dodge.RandomHelp --import qualified Data.Set as S -import Data.Maybe +--import Data.Maybe --import Data.Tree --import Control.Monad.State --import System.Random @@ -44,41 +44,44 @@ analyser -> PlacementSpot -> Placement analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp -> - Just $ plSpot .~ psmc $ putTerminal'' themachine tparams (linksensortotrigger 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) +-- linksensortotrigger tp _ mc +-- = triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc) themachine = defaultMachine & mcColor .~ aquamarine - & mcUpdate .~ mcProximitySensorUpdate +-- & mcUpdate .~ mcProximitySensorUpdate & mcDraw .~ terminalSPic & mcHP .~ 100 & mcSensor .~ defaultProximitySensor {_proxRequirement = proxreq} -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 +--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 diff --git a/src/Dodge/Placement/Instance/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index 252b44b67..f21052478 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/src/Dodge/Placement/Instance/Sensor.hs @@ -14,44 +14,52 @@ import Shape import qualified Data.Map.Strict as M import Control.Lens -import Data.Either +--import Data.Either damageSensor :: DamageType -- Left gets sensed, Right does damage -> Float - -> (Machine -> World -> World) + -> Maybe Int +-- -> (Machine -> World -> World) -> PlacementSpot -> Placement -damageSensor dt wdth upf ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) +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) + $ \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 +-- , _mcUpdate = \mc -> upf mc . sensorUpdate dt mc , _mcSensor = SensorToggleAmount False 0 , _mcLSs = [lsid] } -lightSensor :: Float -> (Machine -> World -> World) -> PlacementSpot -> Placement +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 +-- +--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 diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index dee0d1d34..7e4ee360a 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -10,7 +10,7 @@ module Dodge.Placement.Instance.Terminal import Dodge.Data import Dodge.LevelGen.Data import Dodge.Default -import Dodge.Machine +--import Dodge.Machine import Dodge.SoundLogic import Dodge.Terminal import Color @@ -26,13 +26,15 @@ import Data.Maybe putTerminal'' :: Machine -> Terminal - -> (Int -> Machine -> World -> World) -- | machine update, takes button id as input +-- -> (Int -> Machine -> World -> World) -- | machine update, takes button id as input -> Placement -putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm) +putTerminal'' mc tm --mcf + = ps0PushPS (PutTerminal tm) $ \tmpl -> Just $ ps0PushPS (PutButton termButton) $ \btpl -> Just $ pt0 (PutMachine (reverse $ square 10) - (mc & mcUpdate %~ (\fmu mc' -> mcf (fromJust $ _plMID btpl) mc' . fmu mc') . machineAddSound fridgeHumS + (mc -- & mcUpdate %~ (\fmu mc' -> mcf (fromJust $ _plMID btpl) mc' . fmu mc') . machineAddSound fridgeHumS & mcMounts . at ObButton ?~ fromJust (_plMID btpl) + & mcCloseSound ?~ fridgeHumS ) ) $ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl) where @@ -49,7 +51,7 @@ putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm) putTerminal' :: Color -> Terminal - -> (Int -> Machine -> World -> World) -- | machine update, takes button id as input +-- -> (Int -> Machine -> World -> World) -- | machine update, takes button id as input -> Placement putTerminal' col = putTerminal'' (defaultMachine & mcColor .~ col) @@ -59,7 +61,7 @@ putTerminal' col = putTerminal'' (defaultMachine } putTerminal :: Color -> Terminal -> Placement -putTerminal col f = putTerminal'' (mc & mcColor .~ col) f (\_ -> basicMachineUpdate $ const id) +putTerminal col f = putTerminal'' (mc & mcColor .~ col) f -- (\_ -> basicMachineUpdate $ const id) where mc = defaultMachine { _mcDraw = terminalSPic diff --git a/src/Dodge/Placement/Instance/Turret.hs b/src/Dodge/Placement/Instance/Turret.hs index d07ac32ac..0e63c4b56 100644 --- a/src/Dodge/Placement/Instance/Turret.hs +++ b/src/Dodge/Placement/Instance/Turret.hs @@ -30,8 +30,8 @@ import Data.Maybe putLasTurret :: Float -> Placement putLasTurret rotSpeed = sps0 $ PutMachine (reverse $ square wdth) (defaultMachine & mcColor .~ blue) { _mcDraw = drawTurret - , _mcUpdate = updateTurret rotSpeed - , _mcType = lasTurret +-- , _mcUpdate = updateTurret rotSpeed + , _mcType = lasTurret & tuTurnSpeed .~ rotSpeed , _mcHP = 50000 } lasTurret :: MachineType diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index fb21b386c..c244b4054 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -21,7 +21,7 @@ import LensHelp import RandomHelp import qualified Data.Set as S -import Data.Maybe +--import Data.Maybe cenLasTur :: Room cenLasTur = roomNgon 8 200 & rmPmnts .~ @@ -44,7 +44,8 @@ lightSensInsideDoor outplid rm = rm lasSensLightAboveDoor :: Float -> PlacementSpot -> Placement lasSensLightAboveDoor wth ps = extTrigLitPos (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))) - ( \tp -> Just $ lightSensor wth (upf $ fromJust $ _plMID tp) ps ) + ( \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 diff --git a/src/Dodge/Room/SensorDoor.hs b/src/Dodge/Room/SensorDoor.hs index 9321533d1..cb9cc8adb 100644 --- a/src/Dodge/Room/SensorDoor.hs +++ b/src/Dodge/Room/SensorDoor.hs @@ -60,7 +60,8 @@ 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 (upf $ fromJust $ _plMID tp) ps ) + ( \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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index d82bf7400..f63ee2a73 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -5,6 +5,7 @@ Description : Simulation update -} module Dodge.Update ( updateUniverse ) where import Dodge.Data +import Dodge.Machine.Update import Dodge.RadarBlip import Dodge.Flare import Dodge.Menu @@ -14,7 +15,7 @@ import Dodge.Distortion import Dodge.SoundLogic --import Dodge.Wall.Delete import Dodge.Update.WallDamage -import Dodge.Machine.Destroy +--import Dodge.Machine.Destroy --import Dodge.Menu import Dodge.Base import Dodge.Zone @@ -89,7 +90,8 @@ functionalUpdate cfig w = checkEndGame . zoneClouds . updateMIM magnets _mgUpdate . updateIMl' _terminals tmUpdate - . updateIMl _machines mcChooseUpdate +-- . updateIMl _machines mcChooseUpdate + . updateIMl' _machines updateMachine . updateIMl _creatures _crUpdate -- creatures should be updated early so that crOldPos is set before any position change . over creatures (fmap setOldPos) @@ -125,13 +127,10 @@ updateWorldSelect w = f . g $ case (w ^? mouseButtons . ix ButtonLeft, w ^? mous g | ButtonRight `M.member` _mouseButtons w = rSelect .~ mwp | otherwise = id -mcChooseUpdate :: Machine -> Machine -> World -> World -mcChooseUpdate mc mc' - | _mcHP mc > 0 = _mcUpdate mc mc' - | otherwise = destroyMachine mc --- (machines %~ IM.delete (_mcID mc)) --- . deleteWallIDs (_mcWallIDs mc) --- . _mcDeath mc mc' +--mcChooseUpdate :: Machine -> Machine -> World -> World +--mcChooseUpdate mc mc' +-- | _mcHP mc > 0 = _mcUpdate mc mc' +-- | otherwise = destroyMachine mc tmUpdate :: Terminal -> World -> World tmUpdate tm w = case w ^? terminals . ix (_tmID tm) . tmFutureLines . ix 0 of