diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 01b9fc6a0..f476fca75 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -428,9 +428,9 @@ coordinates. -} cartePosToScreen :: Configuration -> World -> Point2 -> Point2 cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate where - doTranslate p = p -.- _carteCenter w - doZoom p = _carteZoom w *.* p - doRotate p = rotateV (negate $ _carteRot w) p + doTranslate p = p -.- _carteCenter (_hud w) + doZoom p = _carteZoom (_hud w) *.* p + doRotate p = rotateV (negate $ _carteRot (_hud w)) p crToMousePosOffset :: Creature -> World -> (Point2,Float) crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr,0) {- | The mouse position in world coordinates. -} @@ -438,7 +438,8 @@ mouseWorldPos :: World -> Point2 mouseWorldPos w = _cameraCenter w +.+ (1/_cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w) {- | The mouse position in map coordinates -} mouseCartePos :: World -> Point2 -mouseCartePos w = _carteCenter w +.+ (1/_carteZoom w) *.* rotateV (_carteRot w) (_mousePos w) +mouseCartePos w = _carteCenter (_hud w) +.+ (1/_carteZoom (_hud w)) + *.* rotateV (_carteRot (_hud w)) (_mousePos w) {- | Create a logistic function given three parameters. -} logistic :: Float -> Float -> Float -> (Float -> Float) logistic x0 l k x = l / (1 + exp (k*(x0 - x))) diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 9a471bd7c..7b8169c92 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -2,6 +2,7 @@ {- | Basic collision detection for a moving point -} module Dodge.Base.Collide ( hasLOS + , hasButtonLOS , reflectPointWalls , ssfold , collidePointUpToIndirectMinDist @@ -25,6 +26,12 @@ hasLOS :: Point2 -> Point2 -> World -> Bool {-# INLINE hasLOS #-} hasLOS p1 p2 = not . pointHitsWalls p1 p2 . wallsAlongLine p1 p2 +hasButtonLOS :: Point2 -> Point2 -> World -> Bool +{-# INLINE hasButtonLOS #-} +hasButtonLOS p1 p2 = not . pointHitsWalls p1 p2 + . IM.filter (not . _wlTouchThrough) + . wallsAlongLine p1 p2 + --hitPointLines -- :: Point2 -- -> Point2 diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 05b324025..7c99a2ab6 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -104,12 +104,12 @@ combineModules = mergeA h _ im _ = ([],im) toggleCombineInv :: World -> World -toggleCombineInv w = case _inventoryMode w of - CombineInventory _ -> w & inventoryMode .~ TopInventory +toggleCombineInv w = case _hudElement (_hud w) of + DisplayInventory CombineInventory {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory _ -> w & enterCombineInv enterCombineInv :: World -> World -enterCombineInv w = w & inventoryMode .~ CombineInventory mi +enterCombineInv w = w & hud . hudElement .~ DisplayInventory (CombineInventory mi) where mi = 0 <$ listToMaybe (combineItemListYou w) diff --git a/src/Dodge/Combine/Combinations.hs b/src/Dodge/Combine/Combinations.hs index 1b7148bc8..121d44cc9 100644 --- a/src/Dodge/Combine/Combinations.hs +++ b/src/Dodge/Combine/Combinations.hs @@ -59,13 +59,13 @@ itemCombinations = , p [p 2 TUBE,o LAUNCHER] (launcherX 2) ] ++ [ p [p 2 TUBE,o $ LAUNCHERX i] (launcherX (i+1)) | i <- [2..9]] ++ - [ po [LIGHTER,PIPE,CAN] flameStick + [ po [LIGHTER,PUMP,CAN] flameStick , po [FLAMESTICK,CAN,PUMP] blowTorch , po [FLAMESTICK,DRUM] flameThrower , po [FLAMETHROWER,DRUM] flameWall , po [FLAMETHROWER,PUMP] flameTorrent - , p [o PRISM,p 2 PIPE,o HARDWARE] lasGun + , p [o PRISM,o TRANSFORMER,o PIPE] lasGun , p [o TRANSFORMER,p 2 CAN] sparkGun , p [o SPARKGUN,p 2 PIPE] teslaGun diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 40f4365a2..07583ae04 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -110,17 +110,13 @@ data World = World , _pathGraph :: ~(Gr Point2 Float) , _pathGraphP :: ~[(Point2,Point2)] , _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)])) - , _carteDisplay :: Bool - , _carteCenter :: Point2 - , _carteZoom :: Float - , _carteRot :: Float + , _hud :: HUD , _lightSources :: IM.IntMap LightSource , _tempLightSources :: [TempLightSource] , _closeObjects :: [Either FloorItem Button] , _seenLocations :: IM.IntMap (World -> Point2,String) , _selLocation :: Int , _sideEffects :: Universe -> IO Universe - , _inventoryMode :: InventoryMode , _distortions :: [Distortion] , _worldBounds :: Bounds , _gameRooms :: [GameRoom] -- consider using an IntMap @@ -129,10 +125,30 @@ data World = World , _timeFlow :: TimeFlowStatus , _worldClock :: Int , _youHammerPosition :: HammerPosition - , _worldTerminal :: Maybe' WorldTerminal } -data WorldTerminal = WorldTerminal Int [(Int,String)] +data HUDElement = DisplayInventory {_subInventory :: SubInventory} + | DisplayCarte + deriving (Eq,Ord,Show) + +data SubInventory + = NoSubInventory + | TweakInventory + | CombineInventory {_combineInvSel :: Maybe Int} + | InspectInventory + | LockedInventory + | DisplayTerminal + {_termParams :: TerminalParams + ,_termID :: Int + } + deriving (Eq,Ord,Show) + +data HUD = HUD + { _hudElement :: HUDElement + , _carteCenter :: Point2 + , _carteZoom :: Float + , _carteRot :: Float + } data TimeFlowStatus = RewindingNow | RewindingLastFrame @@ -183,13 +199,6 @@ data MenuOption { _moKey :: Scancode , _moEff :: Universe -> IO (Maybe Universe) } -data InventoryMode - = TopInventory - | TweakInventory - | CombineInventory {_combineInvSel :: Maybe Int} - | InspectInventory - | LockedInventory - deriving (Eq, Ord, Show) data CrGroupParams = CrGroupParams { _crGroupParamID :: Int , _crGroupIDs :: IS.IntSet @@ -306,7 +315,14 @@ data Button = Button , _btID :: Int , _btText :: String , _btState :: ButtonState + , _btTerminalParams :: TerminalParams } +data TerminalParams = NoTerminalParams | TerminalParams + { _termDisplayedLines :: [(String,Color)] + , _termFutureLines :: [(Int,(String,Color))] + , _termMaxLines :: Int + } + deriving (Eq,Ord,Show) data ButtonState = BtOn | BtOff | BtNoLabel deriving (Eq, Show) data PressPlate = PressPlate @@ -754,6 +770,7 @@ data Wall = Wall , _wlOpacity :: Opacity , _wlPathable :: Bool , _wlWalkable :: Bool + , _wlTouchThrough :: Bool , _wlFireThrough :: Bool , _wlReflect :: Bool , _wlDraw :: Bool @@ -981,7 +998,6 @@ makeLenses ''LSParam makeLenses ''ItemParams makeLenses ''ItemTweaks makeLenses ''Maybe' -makeLenses ''InventoryMode makeLenses ''ItemPortage makeLenses ''Magnet makeLenses ''Gust @@ -989,3 +1005,7 @@ makeLenses ''GunBarrels makeLenses ''ItemModule makeLenses ''Targeting makeLenses ''Nozzle +makeLenses ''HUD +makeLenses ''HUDElement +makeLenses ''SubInventory +makeLenses ''TerminalParams diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 85a8c2df8..6a07e0974 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -260,6 +260,7 @@ defaultButton = Button , _btID = 0 , _btText = "Button" , _btState = BtOff + , _btTerminalParams = NoTerminalParams } defaultPT :: Prop defaultPT = Projectile diff --git a/src/Dodge/Default/Wall.hs b/src/Dodge/Default/Wall.hs index 7558e5e05..b323ae0ef 100644 --- a/src/Dodge/Default/Wall.hs +++ b/src/Dodge/Default/Wall.hs @@ -13,6 +13,7 @@ defaultWall = Wall , _wlOpacity = Opaque , _wlPathable = False , _wlFireThrough = False + , _wlTouchThrough = False , _wlReflect = False , _wlDraw = True , _wlRotateTo = True diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index a05622093..d32d56637 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -65,10 +65,12 @@ defaultWorld = World , _pathGraph = Data.Graph.Inductive.Graph.empty , _pathGraphP = [] , _pathPoints = IM.empty - , _carteDisplay = False - , _carteCenter = V2 0 0 - , _carteZoom = 0.5 - , _carteRot = 0 + , _hud = HUD + { _hudElement = DisplayInventory NoSubInventory + , _carteCenter = V2 0 0 + , _carteZoom = 0.5 + , _carteRot = 0 + } , _lightSources = IM.empty , _tempLightSources = [youLight] , _closeObjects = [] @@ -80,7 +82,6 @@ defaultWorld = World --, _keyConfig = defaultKeyConfigSDL -- , _config = defaultConfig , _sideEffects = return - , _inventoryMode = TopInventory , _foregroundShape = mempty , _distortions = [] , _gameRooms = [] @@ -90,7 +91,6 @@ defaultWorld = World , _rewindWorlds = [] , _timeFlow = NormalTimeFlow , _youHammerPosition = HammerUp - , _worldTerminal = Nothing' } youLight :: TempLightSource youLight = diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 84a25e0f4..01604976f 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -89,10 +89,12 @@ handleResizeEvent sev u = return . Just $ u handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe handlePressedMouseButton but w - | but == ButtonMiddle || _carteDisplay (_uvWorld w) + | but == ButtonMiddle || _hudElement (_hud $ _uvWorld w) == DisplayCarte = Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) - | but == ButtonLeft = case _inventoryMode (_uvWorld w) of - CombineInventory mi -> Just $ fromMaybe (w & uvWorld . inventoryMode .~ TopInventory) $ do -- ugly + | but == ButtonLeft = case _hudElement (_hud $ _uvWorld w) of + DisplayInventory (CombineInventory mi) + -> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory) + $ do -- ugly i <- mi return $ over uvWorld (doCombine i) w _ -> Just w @@ -117,11 +119,11 @@ handleMouseWheelEvent mwev w = case _menuLayers w of _ -> Just w wheelEvent :: Float -> World -> World -wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of - (True, _) - | rbDown -> w & carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * ) +wheelEvent y w = case _hudElement $ _hud w of + DisplayCarte + | rbDown -> w & hud . carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * ) | otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi) - (_, TopInventory) + DisplayInventory NoSubInventory -- functions that modify the inventory should be centralised so that -- this lock can be sensibly applied, perhaps | _crInvLock (_creatures w IM.! _yourID w) -> w @@ -131,14 +133,14 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of | lbDown -> w & cameraZoom +~ y | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeSwapInvSel yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w - (_, TweakInventory) + DisplayInventory TweakInventory | invKeyDown && rbDown -> w & moveTweakSel yi | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w | rbDown -> w & changeTweakParam yi | otherwise -> w & moveTweakSel yi - (_, CombineInventory _) -> w - & inventoryMode . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) - (_, _) -> w + DisplayInventory (CombineInventory _) -> w + & hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) + _ -> w where numcombs = length $ combineItemListYou w yi = round $ signum y diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 8728dcaa1..82227da02 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -50,14 +50,14 @@ handlePressedKeyInGame scode w = case scode of ScancodeM -> Just $ toggleMap w ScancodeR -> Just $ fromMaybe w $ startReloadingWeapon (you w) w ScancodeT -> Just $ testEvent w - ScancodeX -> Just $ w & inventoryMode %~ toggleInv TweakInventory + ScancodeX -> Just $ w & hud . hudElement %~ toggleInv (DisplayInventory TweakInventory) ScancodeC -> Just $ toggleCombineInv w - ScancodeI -> Just $ w & inventoryMode %~ toggleInv InspectInventory + ScancodeI -> Just $ w & hud . hudElement %~ toggleInv (DisplayInventory InspectInventory) _ -> Just w -toggleInv :: InventoryMode -> InventoryMode -> InventoryMode +toggleInv :: HUDElement -> HUDElement -> HUDElement toggleInv x y - | x == y = TopInventory + | x == y = DisplayInventory NoSubInventory | otherwise = x gotoTerminal :: Universe -> Universe @@ -66,13 +66,14 @@ gotoTerminal w = case _menuLayers w of _ -> w & menuLayers %~ (InputScreen [] :) spaceAction :: World -> World -spaceAction w = if _carteDisplay w - then w & carteCenter .~ theLoc - else case (_inventoryMode w, selectedCloseObject w) of - (TopInventory,Just (_,Left flit)) -> pickUpItem 0 flit w - --(TopInventory,(Just (_,Right but))) -> updateTopCloseObject (_btID but) $ _btEvent but but w - (TopInventory,Just (_,Right but)) -> _btEvent but but w - _ -> w & inventoryMode .~ TopInventory +spaceAction w = case _hudElement $ _hud w of + DisplayCarte -> w & hud . carteCenter .~ theLoc + DisplayInventory NoSubInventory -> case selectedCloseObject w of + Just (_,Left flit) -> pickUpItem 0 flit w + Just (_,Right but) -> _btEvent but but w + _ -> w + DisplayInventory DisplayTerminal {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory + _ -> w & hud . hudElement .~ DisplayInventory NoSubInventory where theLoc = fst (_seenLocations w IM.! _selLocation w) w -- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail @@ -81,6 +82,10 @@ pauseGame :: World -> World pauseGame w = w & sideEffects %~ (. (menuLayers .~ [pauseMenu])) toggleMap :: World -> World -toggleMap w = w & carteDisplay %~ not +toggleMap w = case _hudElement $ _hud w of + DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory + _ -> w & hud . hudElement .~ DisplayCarte escapeMap :: World -> World -escapeMap w = w & carteDisplay .~ False +escapeMap w = case _hudElement $ _hud w of + DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory + _ -> w diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 9e3a79619..bc8a91a8d 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -8,7 +8,7 @@ module Dodge.Floor import Dodge.LockAndKey --import Dodge.Creature.State.Data import Dodge.Room -import Dodge.Data.DamageType +--import Dodge.Data.DamageType --import Dodge.Placement.Instance.Button import Dodge.Tree import Dodge.Annotation @@ -36,7 +36,7 @@ import System.Random initialAnoTree :: RandomGen g => Tree [Annotation g] initialAnoTree = padSucWithCorridors $ treeFromTrunk [[AnoApplyInt 0 startRoom] - , [SpecificRoom $ sensorRoom Flaming 50] +-- , [SpecificRoom $ sensorRoom Flaming 50] , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms] , [SpecificRoom randomChallenges] , [AnoApplyInt 1 lasSensorTurretTest] diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index a9003c8c6..f11679e93 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -12,6 +12,7 @@ module Dodge.Inventory , augmentedInvSizes , rmInvItem , updateCloseObjects + , updateTerminal , closeObjScrollDir , closeObjectCol -- , swapInvDir @@ -33,15 +34,15 @@ import Dodge.Base.Collide import Geometry --import FoldableHelp import Padding +import Color import qualified IntMapHelp as IM import ListHelp -import Color +import LensHelp import qualified Data.IntSet as IS import Data.Maybe --import Data.List --import System.Random -import Control.Lens -- | after this the item at the inventory position will no longer exist rmInvItem :: Int -- ^ Creature id @@ -120,6 +121,33 @@ invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSize | yourInvSel w < length (yourInv w) = 0 | otherwise = 1 +updateTerminal :: World -> World +updateTerminal w = case _hudElement $ _hud w of + DisplayInventory dt@DisplayTerminal{} -> w & hud . hudElement %~ updateDisplayTerminal dt w + _ -> w + +updateDisplayTerminal :: SubInventory -> World -> HUDElement -> HUDElement +updateDisplayTerminal sub w inv + | closetest == Just True = inv & subInventory %~ tickDisplayTerminal + | otherwise = DisplayInventory NoSubInventory + where + closetest = do + btpos <- w ^? buttons . ix (_termID sub) . btPos + return $ dist btpos (_crPos $ you w) < 40 + +tickDisplayTerminal :: SubInventory -> SubInventory +tickDisplayTerminal dt = case dt of + DisplayTerminal{} -> dt & termParams . termDisplayedLines .++~ maybeToList ml + & termParams . termFutureLines .~ newtfl + where + tfl = _termFutureLines $ _termParams dt + (ml,newtfl) = tickFutureLines tfl + tickFutureLines ((0,sc):xs) = (Just sc,xs) + tickFutureLines ((i,sc):xs) = (Nothing,(i-1,sc):xs) + tickFutureLines [] = (Nothing,[]) + _ -> dt + + -- this looks ugly... updateCloseObjects :: World -> World updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose @@ -128,7 +156,7 @@ updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered c updateinvsel curinvsel | length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1 | otherwise = curinvsel - filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasLOS ypos (closeObjPos obj) w + filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w ypos = _crPos $ you w activeButtons = map Right . filter ( (/=) BtNoLabel . _btState) diff --git a/src/Dodge/Inventory/CloseObject.hs b/src/Dodge/Inventory/CloseObject.hs index 1f565f4ee..46a2b94c4 100644 --- a/src/Dodge/Inventory/CloseObject.hs +++ b/src/Dodge/Inventory/CloseObject.hs @@ -2,7 +2,6 @@ module Dodge.Inventory.CloseObject where import Dodge.Data import Geometry - closeObjPos :: Either FloorItem Button -> Point2 closeObjPos e = case e of Right x -> _btPos x diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 2c9674532..d5eac79f4 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -20,7 +20,7 @@ import qualified Data.IntMap.Strict as IM data PSType = PutCrit {_unPutCrit :: Creature} | PutMachine { _putMachineColor :: Color, _putMachinePoly :: [Point2], _unPutMachine :: Machine } | PutLS LightSource - | PutButton Button + | PutButton {_pstPutButton :: Button} | PutProp Prop | PutFlIt Item | PutPPlate PressPlate @@ -52,6 +52,7 @@ data PlacementSpot { _psRoomRandPointNum :: Int , _psRandShift :: (Point2,Float) -> PlacementSpot } +-- TODO attempt to unify/simplify this union type data Placement = Placement { _plSpot :: PlacementSpot @@ -59,7 +60,10 @@ data Placement , _plMID :: Maybe Int , _plIDCont :: Placement -> Maybe Placement } - | PlacementGenUpdate (GenParams -> Placement -> (GenParams, Placement)) Placement + | PlacementGenUpdate + {_plGenUpdate :: (GenParams -> Placement -> (GenParams, Placement)) + ,_plGenPL :: Placement + } | PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position | RandomPlacement {_unRandomPlacement :: State StdGen Placement} | PickOnePlacement Int Placement diff --git a/src/Dodge/LevelGen/Switch.hs b/src/Dodge/LevelGen/Switch.hs index 397734156..4256e136f 100644 --- a/src/Dodge/LevelGen/Switch.hs +++ b/src/Dodge/LevelGen/Switch.hs @@ -28,6 +28,7 @@ makeButton col eff = Button , _btID = 0 , _btText = "Button" , _btState = BtOff + , _btTerminalParams = NoTerminalParams } where turnOn bt = bt {_btState = BtNoLabel, _btEvent = const id} @@ -68,6 +69,7 @@ makeSwitchSPic dswitch effOn effOff = Button , _btID = 0 , _btText = "SWITCH/" , _btState = BtOff + , _btTerminalParams = NoTerminalParams } where flipSwitch b w = switchEffect b . soundFromGeneral (LeverSound 0) (bpos b) click1S Nothing $ w @@ -102,6 +104,7 @@ makeSwitch col1 col2 effOn effOff = Button , _btID = 0 , _btText = "SWITCH/" , _btState = BtOff + , _btTerminalParams = NoTerminalParams } where flipSwitch b w = switchEffect b . soundFromGeneral (LeverSound 0) (bpos b) click1S Nothing $ w diff --git a/src/Dodge/LockAndKey.hs b/src/Dodge/LockAndKey.hs index 4728a9124..b8fc7937e 100644 --- a/src/Dodge/LockAndKey.hs +++ b/src/Dodge/LockAndKey.hs @@ -14,11 +14,14 @@ import Control.Monad.State lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State g CombineType ) ] lockRoomKeyItems = - [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] ) - ,(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 FLAMESTICK ) +-- ,(sensorRoomRunPast Lasering, return LASGUN ) +-- ,(const slowDoorRoomRunPast, return MINIGUN) +-- ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD]) +-- ,(const glassLessonRunPast, takeOne [LASGUN]) +-- ,(const $ lasTunnelRunPast 400, return FLATSHIELD) ] itemRooms :: RandomGen g => [(CombineType, State g (SubCompTree Room))] @@ -30,13 +33,17 @@ itemRooms = ) , (MINIGUN , join $ takeOne [roomMiniIntro, minigunFakeout] ) , (LASGUN , join $ takeOne - [rc $ map makeTypeCraft [PRISM,PIPE,PIPE,HARDWARE] + [rc $ map makeTypeCraft [PRISM,TRANSFORMER,PIPE] ] ) , (SPARKGUN , join $ takeOne [rc $ map makeTypeCraft [TRANSFORMER,CAN,CAN] ] ) + , (FLAMESTICK , join $ takeOne + [rc $ map makeTypeCraft [LIGHTER,PUMP,CAN] + ] + ) , (FLATSHIELD , join $ takeOne [rc $ map makeTypeCraft [PLATE,PLATE] ,rc $ map makeTypeCraft [DRUM,DRUM,PLATE] diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs new file mode 100644 index 000000000..10d46d348 --- /dev/null +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE TupleSections #-} +module Dodge.Placement.Instance.Terminal where +import Dodge.Data +import Dodge.LevelGen.Data +import Dodge.Default +import Color +import Geometry +import ShapePicture +import LensHelp +import Shape + +import Data.Maybe + +putTerminal :: (GenParams -> TerminalParams) -> Placement +putTerminal f = PlacementGenUpdate g $ ps0jPushPS (PutButton $ thebutton) + $ pt0 (PutMachine (dark magenta) (reverse $ square 10) defaultMachine + { _mcDraw = drawTerminal + , _mcHP = 100 + }) + $ const Nothing + where + g gp pl = (gp, pl & plType . pstPutButton . btTerminalParams .~ f gp) + thebutton = Button + { _btPict = const mempty + , _btPos = 0 + , _btRot = 0 + , _btEvent = displayTerminalMessage . _btID + , _btID = 0 + , _btText = "TERMINAL" + , _btState = BtOff + , _btTerminalParams = TerminalParams [] [] 10 + } + +drawTerminal :: Machine -> SPic +drawTerminal _ = noPic $ colorSH (dark green) $ upperPrismPoly 15 $ square 10 + +displayTerminalMessage :: Int -> World -> World +displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory DisplayTerminal + { _termID = btid + , _termParams = fromMaybe NoTerminalParams $ w ^? buttons . ix btid . btTerminalParams + } diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index 3f8e97646..6be259e71 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/src/Dodge/Placement/PlaceSpot.hs @@ -201,6 +201,7 @@ placeMachineWalls col poly mcid wlid = flip (foldr f) $ zip [wlid..] $ loopPairs baseWall = defaultMachineWall & wlColor .~ col & wlStructure . wlStMachine .~ mcid + & wlTouchThrough .~ True mvLS :: Point3 -> Float -> LightSource -> LightSource mvLS (V3 x y z) rot ls = ls & lsParam . lsPos .~ V3 x y z +.+.+ startPos diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs index e944121a7..9420b9ed9 100644 --- a/src/Dodge/PlacementSpot.hs +++ b/src/Dodge/PlacementSpot.hs @@ -8,6 +8,7 @@ module Dodge.PlacementSpot , anyUnusedSpot , unusedSpotAwayFromLink , isUnusedLnk + , isUnusedLnk' , isInLnk , unusedSpotNearInLink , randDirPS @@ -21,7 +22,7 @@ module Dodge.PlacementSpot , twoRoomPoss , isUnusedLinkType , rprBoolShift - , rpBool + , rprBool , shiftInBy , resetPLUse ) where @@ -47,11 +48,18 @@ randDirPS ps = do a <- state $ randomR (0,pi*2) return $ setDirPS a ps -rpBool :: (RoomPos -> Bool) -> PlacementSpot -rpBool t = PSPos (useRoomPosCond t) (const id) Nothing +isUnusedLnk :: RoomPos -> Room -> Bool +isUnusedLnk rp _ = case _rpLinkStatus rp of + UnusedLink {} -> _rpPlacementUse rp == 0 + _ -> False + +isUnusedLnk' :: RoomPos -> Bool +isUnusedLnk' rp = case _rpLinkStatus rp of + UnusedLink {} -> _rpPlacementUse rp == 0 + _ -> False anyUnusedSpot :: PlacementSpot -anyUnusedSpot = rpBool $ \rp -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0 +anyUnusedSpot = rprBool $ \rp _ -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0 rprBool :: (RoomPos -> Room -> Bool) -> PlacementSpot rprBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing @@ -98,18 +106,18 @@ unusedSpotAwayFromInLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink --twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement) -> Placement --twoUnusedLinks = twoRoomPoss isUnusedLnk isUnusedLnk -twoRoomPoss :: (RoomPos -> Bool) - -> (RoomPos -> Bool) +twoRoomPoss :: (RoomPos -> Room -> Bool) + -> (RoomPos -> Room -> Bool) -> (PlacementSpot -> PlacementSpot -> Placement) -> Placement -twoRoomPoss cond1 cond2 f = Placement (rpBool cond1) PutNothing Nothing - $ \pl1 -> Just $ Placement (rpBool cond2) PutNothing Nothing +twoRoomPoss cond1 cond2 f = Placement (rprBool cond1) PutNothing Nothing + $ \pl1 -> Just $ Placement (rprBool cond2) PutNothing Nothing $ \pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2) -isUnusedLnk :: RoomPos -> Bool -isUnusedLnk rp = case _rpLinkStatus rp of - UnusedLink {} -> _rpPlacementUse rp == 0 - _ -> False +--isUnusedLnk :: RoomPos -> Bool +--isUnusedLnk rp = case _rpLinkStatus rp of +-- UnusedLink {} -> _rpPlacementUse rp == 0 +-- _ -> False isInLnk :: RoomPos -> Bool isInLnk rp = case _rpLinkStatus rp of @@ -117,7 +125,7 @@ isInLnk rp = case _rpLinkStatus rp of _ -> False useUnusedLnk :: PlacementSpot -useUnusedLnk = rpBool isUnusedLnk +useUnusedLnk = rprBool isUnusedLnk isUsedLnkUnplaced :: RoomPos -> Bool isUsedLnkUnplaced rp = case _rpLinkStatus rp of @@ -125,8 +133,8 @@ isUsedLnkUnplaced rp = case _rpLinkStatus rp of UsedInLink {} -> _rpPlacementUse rp == 0 _ -> False -useRoomPosCond :: (RoomPos -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos) -useRoomPosCond f = useRoomPosRoomCond $ \rp _ -> f rp +useRoomPosCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos) +useRoomPosCond f = useRoomPosRoomCond $ \rp r -> f rp r useRoomPosRoomCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos) useRoomPosRoomCond t rp r @@ -159,7 +167,7 @@ usedRoomLinkPoss r = mapMaybe f $ _rmPos r _ -> Nothing atFstLnkOut :: PlacementSpot -atFstLnkOut = rpBool $ \rp -> rp ^? rpLinkStatus . rplsChildNum == Just 0 +atFstLnkOut = rprBool $ \rp _ -> rp ^? rpLinkStatus . rplsChildNum == Just 0 atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot atNthLnkOutShiftBy n = rprBoolShift diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index e3d8b46da..20243a09d 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -28,16 +28,16 @@ import SDL (MouseButton (..)) --import Data.Bifunctor hudDrawings :: Configuration -> World -> Picture -hudDrawings cfig w = if _carteDisplay w - then drawCarte cfig w - else drawInGameHUD cfig w +hudDrawings cfig w = case _hudElement $ _hud w of + DisplayCarte -> drawCarte cfig w + DisplayInventory subinv -> drawInGameHUD cfig w + <> subInventoryDisplay subinv cfig w drawInGameHUD :: Configuration -> World -> Picture drawInGameHUD cfig w = pictures [ winScale cfig . dShadCol white $ displayHP 0 cfig w , listTextPicturesAt (halfWidth cfig) 0 cfig $ map text (_testString w w) , inventoryDisplay cfig w - , subInventoryDisplay cfig w ] inventoryDisplay :: Configuration -> World -> Picture @@ -49,7 +49,7 @@ inventoryDisplay cfig w = listTextPicturesAt 0 0 cfig invlist ++ displayFreeSlots ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w)) floorItemsColor - | _inventoryMode w == TopInventory = id + | _hudElement (_hud w) == DisplayInventory NoSubInventory = id | otherwise = color invDimColor nfreeslots = crNumFreeSlots cr displayFreeSlots = case nfreeslots of @@ -57,10 +57,10 @@ inventoryDisplay cfig w = listTextPicturesAt 0 0 cfig invlist 1 -> [color invDimColor . text $ " +1 FREE SLOT"] x -> [color invDimColor . text $ " +" ++ show x ++ " FREE SLOTS"] -subInventoryDisplay :: Configuration -> World -> Picture -subInventoryDisplay cfig w = case _inventoryMode w of +subInventoryDisplay :: SubInventory -> Configuration -> World -> Picture +subInventoryDisplay subinv cfig w = case subinv of LockedInventory -> mempty -- topInvCursor col cursPos cfig w - TopInventory -> pictures + NoSubInventory -> pictures [ selcursor , closeobjectcursor , equipcursor @@ -81,6 +81,10 @@ subInventoryDisplay cfig w = case _inventoryMode w of , invHead cfig "TWEAK" , listTextPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it) ] + DisplayTerminal {_termParams = tp} -> pictures + [ invHead cfig "TERMINAL" + , renderListAt subInvX 60 cfig . reverse $ take (_termMaxLines tp) (_termDisplayedLines tp) + ] CombineInventory mi -> pictures [ invHead cfig "COMBINE" , listTextPicturesAt subInvX 60 cfig $ combineListStringPictures w diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 9b3cdd478..64b722823 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -61,7 +61,7 @@ listTextPictureAt xoff yoff cfig yint = winScale cfig hh = halfHeight cfig renderListAt :: Float -> Float -> Configuration -> [(String,Color)] -> Picture -renderListAt tx ty cfig = listTextPicturesAt tx (negate ty) cfig . map (\(str,col) -> color col $ text str) +renderListAt tx ty cfig = listTextPicturesAt tx ty cfig . map (\(str,col) -> color col $ text str) -- concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [0..] --TODO put the following functions in an appropriate place diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index f99dfec7b..efaae82b2 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -34,7 +34,7 @@ cenLasTur :: Room cenLasTur = roomNgon 8 200 & rmPmnts .~ [ putLasTurret 0.02 , heightWallPS (resetPLUse $ rprBoolShift (const . isInLnk) (shiftInBy 100)) 30 covershape - , mntLightLnkCond $ rpBool isInLnk + , mntLightLnkCond $ rprBool $ const . isInLnk ] where covershape = rectNSEW 10 (-10) 20 (-20) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 20b60cd13..c238dbbd9 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -117,7 +117,7 @@ addButtonSlowDoor x h rm = do Nothing getdoorpos drid w = let Just (a,b) = w ^? doors . ix drid . drPos in (b, argV (a-.-b)) - butPosCond = useRoomPosCond $ \rp -> isUnusedLnk rp && yV2 (_rpPos rp) < 0.5 * h + butPosCond = useRoomPosCond $ \rp _ -> isUnusedLnk' rp && yV2 (_rpPos rp) < 0.5 * h --butPosCond _ = True -- y < h col = dim $ light red cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index fb6d32302..a7e93f072 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -51,6 +51,7 @@ roomRect roomRect x y xn yn = defaultRoom { _rmPolys = [rectNSWE y 0 0 x ] , _rmLinks = lnks + , _rmName = "rect" , _rmPath = concatMap doublePair pth , _rmPos = map (roomposat RoomPosOnPath) posps ++ map (roomposat RoomPosOffPath) interposps @@ -77,7 +78,7 @@ roomRect x y xn yn = defaultRoom ++ m East FromSouth FromNorth elnks ++ m West FromSouth FromNorth wlnks ++ m South FromWest FromEast slnks - m edge edgefrom1 edgefrom2 = zipWith (lnkBothAnd' (OnEdge edge) edgefrom1 edgefrom2) [0..] + m edge edgefrom1 edgefrom2 = zipWith (lnkBothAnd (OnEdge edge) edgefrom1 edgefrom2) [0..] . zipCountDown pth = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn) posps = map (+.+ V2 20 20) $ gridPoints xd (xn+1) yd (yn+1) @@ -86,10 +87,10 @@ roomRect x y xn yn = defaultRoom zipCountDown :: [a] -> [(Int,a)] zipCountDown xs = zip [length xs - 1, length xs - 2 ..] xs -lnkBothAnd' :: RoomLinkType -> (Int -> RoomLinkType) +lnkBothAnd :: RoomLinkType -> (Int -> RoomLinkType) -> (Int -> RoomLinkType) -> Int -> (Int,(Point2,Float)) -> RoomLink -lnkBothAnd' rlt ltcon ltcon2 i (j,(p,a)) = RoomLink +lnkBothAnd rlt ltcon ltcon2 i (j,(p,a)) = RoomLink {_rlType = S.fromList [OutLink,InLink,rlt,ltcon i,ltcon2 j] ,_rlPos = p , _rlDir = a @@ -98,10 +99,13 @@ lnkBothAnd' rlt ltcon ltcon2 i (j,(p,a)) = RoomLink -- it is not clear to me that this works for very small rooms (but it does seem -- to do so) roomRectAutoLinks :: Float -> Float -> Room -roomRectAutoLinks x y = (roomRect x y (f x) (f y)) {_rmPmnts = plmnts} +roomRectAutoLinks x y = (roomRect x y (f x) (f y)) + {_rmPmnts = plmnts + ,_rmName = "autoRect" + } where f z = max 1 $ (ceiling z - 40) `div` 60 - plmnts = [mntLightLnkCond $ resetPLUse $ rpBool isInLnk] + plmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp] {- Combines two rooms into one room. - will have to work out exactly what to do with combining links Mostly involves concatenation. -} diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 22e1ea685..4e9cb3e6b 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -185,9 +185,9 @@ roomOctogon = defaultRoom roomNgon :: Int -> Float -> Room roomNgon n x = defaultRoom { _rmPolys = [poly] - , _rmLinks = muout (init lnks) ++ muin[last lnks] + , _rmLinks = map toBothLnk lnks -- muout (init lnks) ++ muin[last lnks] , _rmPath = [] -- TODO - , _rmPmnts = [mntLightLnkCond $ resetPLUse $ rpBool isInLnk] + , _rmPmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ const . isInLnk] , _rmBound = [poly] , _rmFloor = Tiled [makeTileFromPoly poly 9] , _rmName = show n ++ "gon" diff --git a/src/Dodge/Room/SensorDoor.hs b/src/Dodge/Room/SensorDoor.hs index 7bbe7a47e..c5f6c4223 100644 --- a/src/Dodge/Room/SensorDoor.hs +++ b/src/Dodge/Room/SensorDoor.hs @@ -1,13 +1,14 @@ module Dodge.Room.SensorDoor where import Dodge.LevelGen.Data import Dodge.PlacementSpot +import Dodge.Placement.Instance.Terminal import Dodge.Data import Dodge.Tree --import Dodge.RoomLink import Dodge.Room.Door import Dodge.Room.Procedural import Dodge.Room.Room ---import Dodge.Room.Corridor +import Dodge.Room.Corridor import Dodge.Room.Link --import Dodge.Room.Procedural import Dodge.Room.Foreground @@ -22,11 +23,13 @@ import Geometry --import Padding import Color import Shape +--import Lorem import LensHelp import Dodge.RandomHelp ---import qualified Data.Set as S +import qualified Data.Set as S import Data.Maybe +import Data.Char --import Data.Tree import Control.Monad.State import System.Random @@ -38,6 +41,16 @@ sensorRoom senseType n = do let doorroom = triggerDoorRoom n return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door) +sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (SubCompTree Room) +sensorRoomRunPast dt n = do + t <- sensorRoom dt n + return $ applyToSubforest [0] (++ + [treeFromPost [PassDown $ door & rmConnectsTo .~ S.member InLink + & rmName .~ "test" + ] (UseLabel 0 corridor)] + ) t + --[return $ UseLabel 0 $ door & rmConnectsTo .~ S.member InLink] + sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement sensAboveDoor sensetype wth ps = extTrigLitPos (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))) @@ -48,9 +61,35 @@ sensAboveDoor sensetype wth ps = extTrigLitPos sensInsideDoor :: DamageType -> Int -> Room -> Room sensInsideDoor senseType outplid rm = rm - & rmPmnts .:~ psPt atFstLnkOut - (PutShape $ colorSH yellow $ - thinHighBar 0 (V2 20 (-1)) (V2 20 (-100)) - <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100)) - <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)) + & rmName .++~ take 4 (show senseType) + & rmPmnts .++~ + [ psPt atFstLnkOut + (PutShape $ colorSH yellow $ + thinHighBar 0 (V2 20 (-1)) (V2 20 (-100)) + <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100)) + <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)) + , putTerminal messagef + & plGenPL . plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10) + ] & rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid] + where + mtoup = map toUpper + horline = "-----------------" + topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. length horline -1]] + messagef gp = + let Just (pc,ds) = gp ^? sensorCoding . ix senseType + themessage = + topflush ++ + [horline + ,"SENSOR ATTRIBUTES" + ,horline + ,mtoup $ show senseType + ,"COLOR:"++ mtoup (show pc) + ,"SHAPE:"++ mtoup (reverse . drop 10 . reverse $ show ds) + ,horline + ] + in TerminalParams + {_termDisplayedLines = [] --zip (replicate 7 horline) (repeat white) + ,_termFutureLines = zip (repeat 0) $ zip themessage $ repeat white + ,_termMaxLines = 7 + } diff --git a/src/Dodge/Room/Tanks.hs b/src/Dodge/Room/Tanks.hs index cb9a5e306..417fc19dc 100644 --- a/src/Dodge/Room/Tanks.hs +++ b/src/Dodge/Room/Tanks.hs @@ -41,8 +41,8 @@ tanksRoom crs its = do girderPosOrder <- shuffle [1 .. nwestlnks - 2] let plmnts = --ok, this has become complicated - foldr1 setFallback [ twoRoomPoss (isUnusedLinkType (FromSouth i)) - (isUnusedLinkType (FromSouth i)) $ \ps1 ps2 -> + foldr1 setFallback [ twoRoomPoss (const . isUnusedLinkType (FromSouth i)) + (const . isUnusedLinkType (FromSouth i)) $ \ps1 ps2 -> sps0 $ PutShape $ girderV 96 20 10 (_psPos ps1) (_psPos ps2) | i <- girderPosOrder] : map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its diff --git a/src/Dodge/Tree/Polymorphic.hs b/src/Dodge/Tree/Polymorphic.hs index bb0e7f428..772f640f5 100644 --- a/src/Dodge/Tree/Polymorphic.hs +++ b/src/Dodge/Tree/Polymorphic.hs @@ -9,6 +9,8 @@ the nodes in the trunk are [a,b] (note that d is not the first child of b). -} module Dodge.Tree.Polymorphic ( applyToRoot + , applyToSubtree + , applyToSubforest , treeFromPost , treeFromTrunk , splitTrunk @@ -56,6 +58,22 @@ applyToNode (i:is) f (Node x xs) = Node x (ys ++ [applyToNode is f z] ++ zs) where (ys, z:zs) = splitAt i xs +{- | Applies a function to a specific subtree determined by a list of indices. +Unsafe (partial function). -} +applyToSubtree :: [Int] -> (Tree a -> Tree a) -> Tree a -> Tree a +applyToSubtree [] f t = f t +applyToSubtree (i:is) f (Node x xs) = Node x (ys ++ [applyToSubtree is f z] ++ zs) + where + (ys, z:zs) = splitAt i xs + +{- | Applies a function to a specific subforest determined by a list of indices. +Unsafe (partial function). -} +applyToSubforest :: [Int] -> ([Tree a] -> [Tree a]) -> Tree a -> Tree a +applyToSubforest [] f (Node p cs) = Node p (f cs) +applyToSubforest (i:is) f (Node x xs) = Node x (ys ++ [applyToSubforest is f z] ++ zs) + where + (ys, z:zs) = splitAt i xs + -- do not delete: find use for --{- | --Applies a function to the first node along a trunk that satisfies a given property. diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index b7c199d87..135b278d0 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -73,6 +73,7 @@ functionalUpdate cfig w = checkEndGame . updateBlocks . updateSeenWalls . (youHammerPosition %~ moveHammerUp) + . updateTerminal $ updateCloseObjects w where --updatedLightSources = mapMaybe (\b -> _tlsUpdate b w b) $ _tempLightSources w diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 2a57b5b70..98c4e1f78 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -12,9 +12,9 @@ import qualified Data.Set as S import Control.Lens updateUsingInput :: World -> World -updateUsingInput w = if _carteDisplay w - then updatePressedButtonsCarte (_mouseButtons w) w - else updatePressedButtons (_mouseButtons w) w +updateUsingInput w = case _hudElement $ _hud w of + DisplayInventory {} -> updatePressedButtons (_mouseButtons w) w + DisplayCarte -> updatePressedButtonsCarte (_mouseButtons w) w updatePressedButtons :: S.Set MouseButton -> World -> World updatePressedButtons pkeys w @@ -26,7 +26,7 @@ updatePressedButtons pkeys w & cameraRot -~ rotation | otherwise = w where - inTopInv = _inventoryMode w == TopInventory + inTopInv = _hudElement (_hud w) == DisplayInventory NoSubInventory lbPressed = ButtonLeft `S.member` pkeys rbPressed = ButtonRight `S.member` pkeys mbPressed = ButtonMiddle `S.member` pkeys @@ -35,10 +35,10 @@ updatePressedButtons pkeys w updatePressedButtonsCarte :: S.Set MouseButton -> World -> World updatePressedButtonsCarte pkeys w | rbPressed = w & clickMousePos .~ _mousePos w - & carteCenter %~ (-.- trans) + & hud . carteCenter %~ (-.- trans) | lbPressed = w & clickMousePos .~ _mousePos w - & carteRot -~ rot - & carteZoom *~ czoom + & hud . carteRot -~ rot + & hud . carteZoom *~ czoom | otherwise = w where lbPressed = ButtonLeft `S.member` pkeys @@ -46,4 +46,4 @@ updatePressedButtonsCarte pkeys w --mbPressed = ButtonMiddle `S.member` pkeys rot = angleBetween (_mousePos w) (_clickMousePos w) czoom = magV (_mousePos w) / magV (_clickMousePos w) - trans = rotateV (_carteRot w) $ (1 / _carteZoom w) *.* (_mousePos w -.- _clickMousePos w) + trans = rotateV (_carteRot (_hud w)) $ (1 / _carteZoom (_hud w)) *.* (_mousePos w -.- _clickMousePos w)