diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs index 72889b427..e62f3ab54 100644 --- a/src/Dodge/Combine/Data.hs +++ b/src/Dodge/Combine/Data.hs @@ -111,10 +111,13 @@ data CombineType -- bullet | INCENDIARYMODULE | BOUNCEMODULE - | NoCombineType -- | TELEPORTMODULE | TIMEMODULE | SIZEMODULE | GRAVITYMODULE + -- + | KEYCARD Int + -- + | NoCombineType deriving (Eq,Ord,Show) diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 8ae00645f..ad31fbae6 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -15,9 +15,7 @@ useItem cr' w = fromMaybe (f w) $ do it <- cr ^? crInv . ix (_crInvSel cr) return $ itemEffect cr it w where - f = case _crID cr' of - 0 -> youHammerPosition .~ HammerDown - _ -> id + f = creatures . ix (_crID cr') . crHammerPosition .~ HammerDown itemEffect :: Creature -> Item -> World -> World itemEffect cr it w = case it ^? itUse of @@ -30,19 +28,17 @@ itemEffect cr it w = case it ^? itUse of Just NoUse -> setuhamdown w Nothing -> setuhamdown w where - hammerTest f = case _youHammerPosition w of + hammerTest f = case _crHammerPosition cr of HammerUp -> f w - _ -> w & youHammerPosition .~ HammerDown - lhammer f' = w & case _youHammerPosition w of + _ -> w & setuhamdown + lhammer f' = w & case _crHammerPosition cr of HammerUp -> creatures . ix (_crID cr) %~ f' _ -> id setEquipLeftItem cr' = case _crLeftInvSel cr' of Just i | i == _crInvSel cr' -> cr' & crLeftInvSel .~ Nothing _ -> cr' & crLeftInvSel ?~ _crInvSel cr' setEquipment = toggleEquipmentAt (_crInvSel cr) - setuhamdown = case _crID cr of - 0 -> youHammerPosition .~ HammerDown - _ -> id + setuhamdown = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown toggleEquipmentAt :: Int -> Creature -> Creature toggleEquipmentAt invid cr = cr & crInvEquipped . at invid %~ f diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 1365be188..0db10aa76 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -17,6 +17,7 @@ import Dodge.RandomHelp import Dodge.WorldEvent --import Dodge.WallCreatureCollisions import Dodge.Creature.Action +--import Dodge.Hammer import Geometry import Picture import qualified IntMapHelp as IM @@ -51,9 +52,10 @@ stateUpdateDamage :: (Creature -> Creature) -- -> CRUpdate -> Creature -> World -> World stateUpdateDamage damageupdate u cr w = case u (updateMovement cr) w of - (f, upcr) -> invSideEff upcr . movementSideEff cr . deathEff . f $ w + (f, upcr) -> mvcrhammerup . invSideEff upcr . movementSideEff cr . deathEff . f $ w & creatures . at (_crID cr) .~ (stepReloading . damageupdate <$> crOrCorpse upcr) - where + where + mvcrhammerup = creatures . ix (_crID cr) . crHammerPosition %~ moveHammerUp crOrCorpse cr' | cr' ^. crHP > 0 = Just cr' | otherwise = Nothing diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index be1bf968f..06b13ce5d 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -126,7 +126,6 @@ data World = World , _rewindWorlds :: [World] , _timeFlow :: TimeFlowStatus , _worldClock :: Int - , _youHammerPosition :: HammerPosition } data HUDElement = DisplayInventory {_subInventory :: SubInventory} @@ -287,6 +286,7 @@ data Creature = Creature , _crGroup :: CrGroup , _crIntention :: Intention , _crMvType :: CrMvType + , _crHammerPosition :: HammerPosition } data Vocalization = Mute diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index a360d3b05..45516c4ed 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -60,6 +60,7 @@ defaultCreature = Creature , _crIntention = defaultIntention , _crGroup = LoneWolf , _crMvType = defaultAimMvType + , _crHammerPosition = HammerUp } defaultInanimate :: Creature defaultInanimate = defaultCreature & crActionPlan .~ Inanimate diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 81d903db8..b9032a29e 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -91,7 +91,6 @@ defaultWorld = World , _maybeWorld = Nothing' , _rewindWorlds = [] , _timeFlow = NormalTimeFlow - , _youHammerPosition = HammerUp } youLight :: TempLightSource youLight = diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index c6504e736..9a8946640 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -37,7 +37,7 @@ initialAnoTree :: RandomGen g => Tree [Annotation g] initialAnoTree = padSucWithDoors $ treeFromTrunk [[AnoApplyInt 0 startRoom] , [AnoApplyInt 100 healthTest] - , [SpecificRoom $ return . UseAll <$> tanksRoom [] []] +-- , [SpecificRoom $ return . UseAll <$> tanksRoom [] []] , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms] , [SpecificRoom randomChallenges] , [AnoApplyInt 1 lasSensorTurretTest] diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 9762c0f54..656145cc4 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -41,8 +41,9 @@ initialWorld = defaultWorld } testStringInit :: World -> [String] +testStringInit = const [] --testStringInit = map (concatMap $ \(_,ct,_,_) -> show ct) . invertListInvMult . yourInv -testStringInit w = [show $ _youHammerPosition w] +--testStringInit w = fmap (show . _crHammerPosition) . IM.elems $ _creatures w -- w = [show $ f $ _roomClipping w] -- where -- f (x:xs) = any (convexPolysOverlap x) xs || f xs diff --git a/src/Dodge/Item.hs b/src/Dodge/Item.hs index f7c16ec7d..bdbaada16 100644 --- a/src/Dodge/Item.hs +++ b/src/Dodge/Item.hs @@ -1,43 +1,8 @@ -module Dodge.Item - where -import Dodge.Data -import Dodge.Default -import Picture -import Geometry.Data ---import ShapePicture -import Shape - -keyToken :: Int -> Item -keyToken n = defaultEquipment - { _itType = NOTDEFINED - , _itName = "KEYTOKEN "++show n - , _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic - , _itEffect = NoItEffect - , _itID = Nothing --- , _itZoom = defaultItZoom - , _itInvColor = yellow - , _itInvDisplay = (:[]) . _itName - } -keyPic :: Picture -keyPic = color green $ - pictures [translate (-4) 0 $ thickCircle 4 2 - ,thickLine 2 $ map toV2 [(0,0),(8,0),(8,-4)] - ,thickLine 2 $ map toV2 [(4,0),(4,-4)] - ] - -latchkey :: Int -> Item -latchkey n = defaultEquipment - { _itType = NOTDEFINED - , _itName = "KEY "++show n - , _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic - , _itEffect = NoItEffect - , _itID = Nothing --- , _itZoom = defaultItZoom - , _itInvColor = yellow - } -latchkeyPic :: Picture -latchkeyPic = color yellow $ - pictures [translate (-4) 0 $ thickCircle 4 2 - ,thickLine 2 $ map toV2 [(0,0),(8,0),(8,-4)] - ,thickLine 2 $ map toV2 [(4,0),(4,-4)] - ] +module Dodge.Item + ( module Dodge.Item.Weapon + , module Dodge.Item.Consumable + , module Dodge.Item.PassKey + ) where +import Dodge.Item.Weapon +import Dodge.Item.Consumable +import Dodge.Item.PassKey diff --git a/src/Dodge/LockAndKey.hs b/src/Dodge/LockAndKey.hs index a2a6d8b78..0c3326d8e 100644 --- a/src/Dodge/LockAndKey.hs +++ b/src/Dodge/LockAndKey.hs @@ -7,6 +7,7 @@ import Dodge.RandomHelp import Dodge.Creature import Dodge.Item.Craftable import Dodge.Item.Weapon.BulletGun.Rod +import Dodge.Item --import Dodge.Item.Equipment import System.Random @@ -14,14 +15,15 @@ import Control.Monad.State lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State g CombineType ) ] lockRoomKeyItems = - [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] ) - ,(sensorRoomRunPast Electrical, return SPARKGUN ) - ,(sensorRoomRunPast Flaming, return FLAMESPITTER ) - ,(sensorRoomRunPast Lasering, return LASGUN ) - ,(const slowDoorRoomRunPast, return MINIGUN) - ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD]) - ,(const glassLessonRunPast, takeOne [LASGUN]) - ,(const $ lasTunnelRunPast 400, return FLATSHIELD) +-- [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] ) +-- ,(sensorRoomRunPast Electrical, return SPARKGUN ) +-- ,(sensorRoomRunPast Flaming, return FLAMESPITTER ) +-- ,(sensorRoomRunPast Lasering, return LASGUN ) +-- ,(const slowDoorRoomRunPast, return MINIGUN) +-- ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD]) +-- ,(const glassLessonRunPast, takeOne [LASGUN]) +-- ,(const $ lasTunnelRunPast 400, return FLATSHIELD) + [(keyCardRoomRunPast 0, return (KEYCARD 0)) ] itemRooms :: RandomGen g => [(CombineType, State g (SubCompTree Room))] @@ -56,6 +58,10 @@ itemRooms = [rc [sniperRifle] ] ) + , (KEYCARD 0 , join $ takeOne + [rc [keyCard 0] + ] + ) ] where rc its = do diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index 09808b765..7eb0e50db 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -115,10 +115,11 @@ analyser starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \tp _ -> (fails,red) updatebuttontext = plType . putButton . btText .~ "ANALYSER" -testYourHealth :: Int -> Machine -> World -> World -testYourHealth hp mc w = case (_sensCloseToggle sens +analyserTest :: (World -> Bool) -> Machine -> World -> World +analyserTest t mc w = case + (_sensCloseToggle sens , _sensToggle sens - , _crHP ycr >= hp + , t w , dist (_crPos ycr) (_mcPos mc) < 40) of (_,True,_,_) -> w (_,False,True,True) -> w @@ -133,3 +134,9 @@ testYourHealth hp mc w = case (_sensCloseToggle sens playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing ycr = you w sens = _mcSensor mc + +testYouHave :: CombineType -> Machine -> World -> World +testYouHave ct = analyserTest (\w -> any (\itm -> _itType itm == ct) (_crInv (you w))) + +testYourHealth :: Int -> Machine -> World -> World +testYourHealth hp = analyserTest (\w -> _crHP (you w) >= hp) diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index 89304a321..4e573fe6e 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -60,7 +60,7 @@ lasSensLightAboveDoor wth ps = extTrigLitPos | otherwise = w lightSensByDoor :: Int -> Room -> Room -lightSensByDoor outplid rm = rm +lightSensByDoor outplid rm = rm & rmPmnts .++~ [ psPt atFstLnkOut $ PutShape $ colorSH yellow $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80) @@ -72,6 +72,28 @@ lightSensByDoor outplid rm = rm covershape = rectNSEW 10 (-10) 20 (-20) sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a) +keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (SubCompTree Room) +keyCardRoomRunPast keyid rmid = do + cenroom <- shuffleLinks $ keyCardAnalyserByDoor keyid rmid $ roomNgon 6 200 + let doorroom = triggerDoorRoom rmid + return $ treeFromTrunk [PassDown door] $ Node (PassDown cenroom) + [ treeFromPost [PassDown doorroom] (UseAll door) + , treeFromPost [PassDown door] (UseLabel 0 corridor) + ] + +keyCardAnalyserByDoor :: Int -> Int -> Room -> Room +keyCardAnalyserByDoor keyid = analyserByDoor + [ bar + , hic + , bar ] + "UNLOCKED" + ("REQUIRES KEYCARD-"++ show keyid) + (bar : replicate 2 "") + (machineAddSound fridgeHumS $ testYouHave (KEYCARD 0)) + where + hic = "HEALTH INTEGRITY CHECK" + bar = replicate (length hic) '-' + healthAnalyserByDoor :: Int -> Room -> Room healthAnalyserByDoor = analyserByDoor [ bar diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 135b278d0..2830c2c35 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -5,7 +5,6 @@ Description : Simulation update module Dodge.Update ( updateUniverse ) where import Dodge.Data import Dodge.Menu -import Dodge.Hammer import Dodge.Block import Dodge.Distortion import Dodge.SoundLogic @@ -72,7 +71,7 @@ functionalUpdate cfig w = checkEndGame . updateCreatureGroups . updateBlocks . updateSeenWalls - . (youHammerPosition %~ moveHammerUp) +-- . (youHammerPosition %~ moveHammerUp) . updateTerminal $ updateCloseObjects w where