From 7d7ed6689d95667ea4de2a9a2544d2dd96b5b7a8 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 14 Jul 2022 21:32:19 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Default.hs | 135 +--------------------- src/Dodge/Default/Creature.hs | 139 +++++++++++++++++++++++ src/Dodge/Floor.hs | 2 +- src/Dodge/Machine/Update.hs | 11 +- src/Dodge/Placement/Instance/Analyser.hs | 2 +- src/Dodge/Placement/Instance/Terminal.hs | 49 +++----- src/Dodge/Room/LasTurret.hs | 7 +- src/Dodge/Room/LongDoor.hs | 2 +- src/Dodge/Room/SensorDoor.hs | 2 +- src/Dodge/Room/Warning.hs | 12 +- 10 files changed, 173 insertions(+), 188 deletions(-) create mode 100644 src/Dodge/Default/Creature.hs diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 18a55e039..301eb118a 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -10,154 +10,23 @@ module Dodge.Default , module Dodge.Default.LightSource , module Dodge.Default.Weapon , module Dodge.Default.Wall + , module Dodge.Default.Creature ) where import Dodge.Default.Wall +import Dodge.Default.Creature import Dodge.Default.Weapon import Dodge.Default.LightSource import Dodge.Default.Item import Dodge.Data import Dodge.SoundLogic -import Dodge.Creature.Damage -import Dodge.Creature.Picture import Geometry import Picture import ShapePicture import Shape import Control.Lens -import qualified Data.IntMap.Strict as IM import qualified Data.Text as T import qualified Data.Map.Strict as M ---import qualified Data.Vector as V ---import Data.Monoid -defaultCreature :: Creature -defaultCreature = Creature - { _crPos = V2 0 0 - , _crOldPos = V2 0 0 - , _crVel = V2 0 0 - , _crDir = 0 - , _crOldDir = 0 - , _crMvDir = 0 - , _crTwist = 0 - , _crID = 1 --- , _crPict = basicCrPict - , _crType = defaultCreatureSkin - , _crUpdate = const id - , _crRad = 10 - , _crMass = 10 - , _crHP = 100 - , _crMaxHP = 150 - , _crInv = IM.empty - , _crInvSel = InvSel 0 NoInvSelAction - , _crInvCapacity = 25 - , _crInvLock = False - , _crInvEquipped = mempty - , _crLeftInvSel = Nothing - , _crState = defaultState - , _crCorpse = basicCrCorpse - , _crApplyDamage = defaultApplyDamage - , _crPastDamage = 0 - , _crEquipment = M.empty - , _crStance = Stance - {_carriage=Walking 0 WasLeftForward - ,_posture=AtEase - ,_strideLength = yourDefaultStrideLength - } - , _crVocalization = Mute - , _crActionPlan = ActionPlan [] [] (StrategyActions WatchAndWait [StartSentinelPost]) [LiveLongAndProsper] - , _crPerception = defaultPerceptionState - , _crMemory = defaultCreatureMemory - , _crMeleeCooldown = 0 - , _crFaction = NoFaction - , _crIntention = defaultIntention - , _crGroup = LoneWolf - , _crMvType = defaultAimMvType - , _crHammerPosition = HammerUp - , _crName = "DEFAULTCRNAME" - , _crStatistics = CreatureStatistics 10 10 10 - , _crCamouflage = FullyVisible - } -defaultCreatureSkin :: CreatureType -defaultCreatureSkin = Humanoid (greyN 0.9) (light4 green) (greyN 0.3) - -defaultInanimate :: Creature -defaultInanimate = defaultCreature & crActionPlan .~ Inanimate - -defaultCreatureMemory :: Memory -defaultCreatureMemory = Memory - { _soundsToInvestigate = [] - , _nodesSearched = [] - } - -defaultInvSize :: Int -defaultInvSize = 20 - -defaultPerceptionState :: Perception -defaultPerceptionState = Perception - { _cpVigilance = Lethargic - , _cpAttention = AttentiveTo IM.empty - , _cpAwareness = IM.empty - , _cpVision = defaultVision - , _cpAudition = defaultAudition - } -defaultVision :: Vision -defaultVision = Eyes - { _viFOV = f - , _viDist = g - } - where - f x | abs x < 0.5 * pi = 1 - | otherwise = 0 - g x | x > 500 = 0 - | otherwise = 1 -defaultAudition :: Audition -defaultAudition = Ears - { _auDist = id - } -defaultIntention :: Intention -defaultIntention = Intention - { _targetCr = Nothing - , _mvToPoint = Nothing - , _viewPoint = Nothing - } -defaultChaseMvType :: CrMvType -defaultChaseMvType = CrMvType - { _mvSpeed = 2 - , _mvTurnRad = f - , _mvTurnJit = 0.2 - , _mvAimSpeed = g - } - where - g x | x > pi/8 = 0.2 - | otherwise = 0.01 - f x | x > pi / 4 = 0.2 - | otherwise = 0.05 -defaultAimMvType :: CrMvType -defaultAimMvType = CrMvType - { _mvSpeed = 3 - , _mvTurnRad = const 0.2 - , _mvTurnJit = 0.05 - , _mvAimSpeed = f - } - where - f x | x > pi/8 = 0.2 - | otherwise = 0.01 -defaultAimingCrit :: Creature -defaultAimingCrit = defaultCreature { _crMvType = defaultAimMvType } - -yourDefaultSpeed :: Float -yourDefaultSpeed = 3 - -yourDefaultStrideLength :: Int -yourDefaultStrideLength = 40 - -defaultState :: CreatureState -defaultState = CrSt - { _csDamage = [] --- , _crPastDamage = V.fromList $ replicate 20 [] - , _csSpState = GenCr - , _csDropsOnDeath = DropAll - } defaultEquipment :: Item defaultEquipment = defaultItem diff --git a/src/Dodge/Default/Creature.hs b/src/Dodge/Default/Creature.hs new file mode 100644 index 000000000..cc8504f44 --- /dev/null +++ b/src/Dodge/Default/Creature.hs @@ -0,0 +1,139 @@ +module Dodge.Default.Creature where +import Dodge.Data +import Dodge.Creature.Picture +import Dodge.Creature.Damage +import Geometry.Data +import Picture + +import qualified Data.IntMap.Strict as IM +import qualified Data.Map.Strict as M + +import Control.Lens +defaultCreature :: Creature +defaultCreature = Creature + { _crPos = V2 0 0 + , _crOldPos = V2 0 0 + , _crVel = V2 0 0 + , _crDir = 0 + , _crOldDir = 0 + , _crMvDir = 0 + , _crTwist = 0 + , _crID = 1 +-- , _crPict = basicCrPict + , _crType = defaultCreatureSkin + , _crUpdate = const id + , _crRad = 10 + , _crMass = 10 + , _crHP = 100 + , _crMaxHP = 150 + , _crInv = IM.empty + , _crInvSel = InvSel 0 NoInvSelAction + , _crInvCapacity = 25 + , _crInvLock = False + , _crInvEquipped = mempty + , _crLeftInvSel = Nothing + , _crState = defaultState + , _crCorpse = basicCrCorpse + , _crApplyDamage = defaultApplyDamage + , _crPastDamage = 0 + , _crEquipment = M.empty + , _crStance = Stance + {_carriage=Walking 0 WasLeftForward + ,_posture=AtEase + ,_strideLength = yourDefaultStrideLength + } + , _crVocalization = Mute + , _crActionPlan = ActionPlan [] [] (StrategyActions WatchAndWait [StartSentinelPost]) [LiveLongAndProsper] + , _crPerception = defaultPerceptionState + , _crMemory = defaultCreatureMemory + , _crMeleeCooldown = 0 + , _crFaction = NoFaction + , _crIntention = defaultIntention + , _crGroup = LoneWolf + , _crMvType = defaultAimMvType + , _crHammerPosition = HammerUp + , _crName = "DEFAULTCRNAME" + , _crStatistics = CreatureStatistics 10 10 10 + , _crCamouflage = FullyVisible + } +defaultCreatureSkin :: CreatureType +defaultCreatureSkin = Humanoid (greyN 0.9) (light4 green) (greyN 0.3) + +defaultInanimate :: Creature +defaultInanimate = defaultCreature & crActionPlan .~ Inanimate + +defaultCreatureMemory :: Memory +defaultCreatureMemory = Memory + { _soundsToInvestigate = [] + , _nodesSearched = [] + } + +defaultInvSize :: Int +defaultInvSize = 20 + +defaultPerceptionState :: Perception +defaultPerceptionState = Perception + { _cpVigilance = Lethargic + , _cpAttention = AttentiveTo IM.empty + , _cpAwareness = IM.empty + , _cpVision = defaultVision + , _cpAudition = defaultAudition + } +defaultVision :: Vision +defaultVision = Eyes + { _viFOV = f + , _viDist = g + } + where + f x | abs x < 0.5 * pi = 1 + | otherwise = 0 + g x | x > 500 = 0 + | otherwise = 1 +defaultAudition :: Audition +defaultAudition = Ears + { _auDist = id + } +defaultIntention :: Intention +defaultIntention = Intention + { _targetCr = Nothing + , _mvToPoint = Nothing + , _viewPoint = Nothing + } +defaultChaseMvType :: CrMvType +defaultChaseMvType = CrMvType + { _mvSpeed = 2 + , _mvTurnRad = f + , _mvTurnJit = 0.2 + , _mvAimSpeed = g + } + where + g x | x > pi/8 = 0.2 + | otherwise = 0.01 + f x | x > pi / 4 = 0.2 + | otherwise = 0.05 +defaultAimMvType :: CrMvType +defaultAimMvType = CrMvType + { _mvSpeed = 3 + , _mvTurnRad = const 0.2 + , _mvTurnJit = 0.05 + , _mvAimSpeed = f + } + where + f x | x > pi/8 = 0.2 + | otherwise = 0.01 +defaultAimingCrit :: Creature +defaultAimingCrit = defaultCreature { _crMvType = defaultAimMvType } + +yourDefaultSpeed :: Float +yourDefaultSpeed = 3 + +yourDefaultStrideLength :: Int +yourDefaultStrideLength = 40 + +defaultState :: CreatureState +defaultState = CrSt + { _csDamage = [] +-- , _crPastDamage = V.fromList $ replicate 20 [] + , _csSpState = GenCr + , _csDropsOnDeath = DropAll + } diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 500261256..b3f62917e 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -62,7 +62,7 @@ initialAnoTree = OnwardList , IntAnno $ PassthroughLockKeyLists [(sensorRoomRunPast ELECTRICAL, takeOne [CRAFT STATICMODULE,HELD SPARKGUN] )] itemRooms , IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms - , IntAnno $ AnTree . warningRooms + , IntAnno $ AnTree . warningRooms "INVISIBLE CREATURE AHEAD" , AnTree $ rToOnward "chaseCrit+armourChaseCrit rectRoom" $ return . cleatOnward $ roomRectAutoLinks 400 400 & rmPmnts .++~ [ spNoID anyUnusedSpot (PutCrit invisibleChaseCrit) diff --git a/src/Dodge/Machine/Update.hs b/src/Dodge/Machine/Update.hs index 219b3d39f..ae6ecafc2 100644 --- a/src/Dodge/Machine/Update.hs +++ b/src/Dodge/Machine/Update.hs @@ -111,14 +111,15 @@ mcTriggerVal :: Machine -> Maybe Bool mcTriggerVal mc = case mc ^. mcSensor of NoSensor -> Nothing s@ProximitySensor{} -> s ^? sensToggle - s@SensorToggleAmount{} -> Just $ (_sensAmount s) > 900 + s@SensorToggleAmount{} -> Just $ _sensAmount s > 900 mcPlaySound :: Machine -> World -> World mcPlaySound mc w = case _mcCloseSound mc of - Just sid | d < 200 -> soundContinueVol (1-0.01*max 0 (d-100)) (MachineSound mid) (_mcPos mc) sid (Just 2) w - _ -> w + Just sid | d < 100 + -> soundContinueVol (1-0.01*d) (MachineSound mid) (_mcPos mc) sid (Just 2) w + _ -> w where - d = dist (_crPos $ you w) (_mcPos mc) + d = max 0 (dist (_crPos $ you w) (_mcPos mc) - 100) mid = _mcID mc mcApplyDamage :: [Damage] -> Machine -> World -> World @@ -130,7 +131,7 @@ mcApplyDamage ds mc = case _mcSensor mc of mcSensorUpdate :: Machine -> World -> World mcSensorUpdate mc w = case _mcSensor mc of NoSensor -> w - SensorToggleAmount{} -> foldr (flip sensorUpdate mc) w (map _dmType $ _mcDamage mc) + SensorToggleAmount{} -> foldr (flip sensorUpdate mc . _dmType) w (_mcDamage mc) ProximitySensor{} -> mcProximitySensorUpdate mc w mcProximitySensorUpdate :: Machine -> World -> World diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index fc3b7f041..850d1acb7 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -44,7 +44,7 @@ analyser -> PlacementSpot -> Placement analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp -> - Just $ plSpot .~ psmc $ putTerminal'' + Just $ plSpot .~ psmc $ putTerminal (themachine & mcMounts . at ObTrigger .~ _plMID tp) tparams -- (linksensortotrigger tp) where diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 7e4ee360a..49abbd569 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -1,8 +1,7 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Placement.Instance.Terminal - ( putTerminal - , putTerminal' - , putTerminal'' + ( putMessageTerminal + , putTerminal , simpleTermMessage , terminalColor , terminalSPic @@ -23,19 +22,15 @@ import Shape import Data.Maybe -putTerminal'' - :: Machine - -> Terminal --- -> (Int -> Machine -> World -> World) -- | machine update, takes button id as input - -> Placement -putTerminal'' mc tm --mcf +putTerminal :: Machine -> Terminal -> Placement +putTerminal mc tm = 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 - & mcMounts . at ObButton ?~ fromJust (_plMID btpl) - & mcCloseSound ?~ fridgeHumS - ) ) + $ \btpl -> Just $ pt0 + (PutMachine (reverse $ square 10) + (mc & mcMounts . at ObButton ?~ fromJust (_plMID btpl) + & mcCloseSound ?~ fridgeHumS) + ) $ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl) where setids tmpl btpl mcpl w = w @@ -48,25 +43,11 @@ putTerminal'' mc tm --mcf btid = fromJust (_plMID btpl) mcid = fromJust (_plMID mcpl) -putTerminal' - :: Color - -> Terminal --- -> (Int -> Machine -> World -> World) -- | machine update, takes button id as input - -> Placement -putTerminal' col = putTerminal'' (defaultMachine - & mcColor .~ col) - { _mcDraw = noPic . terminalShape - , _mcHP = 100 - , _mcSensor = defaultProximitySensor - } - -putTerminal :: Color -> Terminal -> Placement -putTerminal col f = putTerminal'' (mc & mcColor .~ col) f -- (\_ -> basicMachineUpdate $ const id) - where - mc = defaultMachine - { _mcDraw = terminalSPic - , _mcHP = 100 - } +putMessageTerminal :: Color -> Terminal -> Placement +putMessageTerminal col = putTerminal $ defaultMachine + & mcColor .~ col + & mcDraw .~ terminalSPic + & mcHP .~ 100 termButton :: Button termButton = Button @@ -86,11 +67,9 @@ terminalColor :: Color terminalColor = dark magenta terminalSPic :: Machine -> SPic ---terminalShape _ = upperPrismPoly 15 $ square 10 terminalSPic = noPic . terminalShape terminalShape :: Machine -> Shape ---terminalShape _ = upperPrismPoly 15 $ square 10 terminalShape mc = colorSH col (prismPoly [V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10] [V3 10 10 0, V3 (-10) 10 0, V3 (-10) (-10) 0, V3 10 (-10) 0] diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index 15b527cea..359dad06a 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -40,10 +40,7 @@ lightSensInsideDoor outplid rm = rm , psPt atFstLnkOut (PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100))) , psPt atFstLnkOut (PutForeground $ verticalWire (V2 20 0) 0 80) ] - & rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 10 (atFstLnkOutShiftInward 100)) outplid] - -lasSensLightAboveDoor :: Float -> PlacementSpot -> Placement -lasSensLightAboveDoor = sensAboveDoor LASERING + & rmOutPmnt .~ [OutPlacement (sensAboveDoor LASERING 10 (atFstLnkOutShiftInward 100)) outplid] lightSensByDoor :: Int -> Room -> Room lightSensByDoor outplid rm = rm @@ -52,7 +49,7 @@ lightSensByDoor outplid rm = rm , heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape , heightWallPS (atFstLnkOutShiftInward 100) 30 covershape ] - & rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 20 (atFstLnkOutShiftBy sensorshift)) outplid] + & rmOutPmnt .~ [OutPlacement (sensAboveDoor LASERING 20 (atFstLnkOutShiftBy sensorshift)) outplid] where covershape = rectNSWE 10 (-10) (-20) 20 sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 8b0a530d8..b1ed886ca 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -98,7 +98,7 @@ addButtonSlowDoor x h rm = do & rmPmnts .++~ [butDoor , theterminal] & rmBound .:~ openDoorBound where - theterminal = putTerminal terminalColor (simpleTermMessage themessage) + theterminal = putMessageTerminal terminalColor (simpleTermMessage themessage) & plSpot .~ rprBoolShift (isUnusedLnkType InLink) (shiftByV2 (V2 0 (-10))) themessage = ["WARNING:" diff --git a/src/Dodge/Room/SensorDoor.hs b/src/Dodge/Room/SensorDoor.hs index 53ce6011b..dd8ddfc3a 100644 --- a/src/Dodge/Room/SensorDoor.hs +++ b/src/Dodge/Room/SensorDoor.hs @@ -67,7 +67,7 @@ sensInsideDoor senseType outplid rm = rm [ psPt atFstLnkOut . PutForeground $ floorWire (V2 20 0) (V2 20 (-100)) , psPt atFstLnkOut . PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100)) , psPt atFstLnkOut . PutForeground $ verticalWire (V2 20 0) 0 80 - , putTerminal terminalColor (basicTerminal & tmScrollCommands .:~ damageCodeCommand) + , putMessageTerminal terminalColor (basicTerminal & tmScrollCommands .:~ damageCodeCommand) & plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10) ] & rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid] diff --git a/src/Dodge/Room/Warning.hs b/src/Dodge/Room/Warning.hs index 0a6de658c..ae73d937c 100644 --- a/src/Dodge/Room/Warning.hs +++ b/src/Dodge/Room/Warning.hs @@ -38,21 +38,21 @@ import qualified Data.Map.Strict as M --import qualified Data.Text as T -warningRooms :: RandomGen g => Int -> State g (MetaTree Room String) -warningRooms n = do +warningRooms :: RandomGen g => String -> Int -> State g (MetaTree Room String) +warningRooms str n = do rm <- do tr <- tanksRoom [] [] takeOne [roomNgon 8 200, roomRectAutoLinks 200 200,tr] - cenroom <- shuffleLinks $ addWarningTerminal n rm + cenroom <- shuffleLinks $ addWarningTerminal str n rm rToOnward "warningRooms" $ treePost [ door, cenroom, triggerDoorRoom n, cleatOnward door] -addWarningTerminal :: Int -> Room -> Room -addWarningTerminal outplid = (rmName .++~ "warningTerm-") +addWarningTerminal :: String -> Int -> Room -> Room +addWarningTerminal str outplid = (rmName .++~ "warningTerm-") . (rmOutPmnt .~ [OutPlacement outplace outplid]) where outplace = extTrigLitPos (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))) - (Just . set plSpot (rprShift moveToSideFirstOutLink) . putTerminal terminalColor . termMessages) + (Just . set plSpot (rprShift moveToSideFirstOutLink) . putMessageTerminal terminalColor . termMessages) termMessages trpl = basicTerminal & tmScrollCommands .:~ toggleCommand & tmToggles .~ M.fromList [("DOOR",TerminalToggle (fromJust $ _plMID trpl) (const (const True)))]