diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index ded5a3e69..66edce386 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -386,7 +386,6 @@ data Targeting , _tgDraw :: Int -> Item -> Creature -> World -> Picture , _tgID :: Maybe Int , _tgActive :: Bool - , _tgPoints :: [Point2] } data ModuleSlot = ModBullet diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index d9f18f065..ef2f9c3dc 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -34,7 +34,7 @@ import System.Random initialAnoTree :: RandomGen g => Tree [Annotation g] initialAnoTree = padSucWithCorridors $ treeFromTrunk [[AnoApplyInt 0 startRoom] - , [SpecificRoom $ fmap (return . PassDown) longRoom] +-- , [SpecificRoom $ fmap (return . PassDown) longRoom] , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms] , [SpecificRoom randomChallenges] , [AnoApplyInt 1 lasSensorTurretTest] diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 46b4efb70..a71cd75fa 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -57,23 +57,21 @@ defaultTargeting = TargetingOnHeld , _tgDraw = \_ _ _ _ -> mempty , _tgID = Nothing , _tgActive = False - , _tgPoints = [] } targetLaser :: Targeting targetLaser = defaultTargeting & tgUpdate .~ targetLaserUpdate - & tgDraw .~ targetLaserDraw targetRBPress :: Targeting targetRBPress = defaultTargeting - & tgUpdate .~ targetRBPressUpdate + & tgUpdate .~ targetUpdateWith targetRBPressUpdate & tgDraw .~ targetSimpleDraw targetRBCreature :: Targeting targetRBCreature = defaultTargeting - & tgUpdate .~ targetRBCreatureUpdate + & tgUpdate .~ targetUpdateWith targetRBCreatureUpdate & tgDraw .~ targetRBCreatureDraw targetCursor :: Targeting targetCursor = defaultTargeting - & tgUpdate .~ targetCursorUpdate + & tgUpdate .~ targetUpdateWith targetCursorUpdate & tgDraw .~ targetSimpleDraw targetSimpleDraw :: Int -> Item -> Creature -> World -> Picture targetSimpleDraw _ it _ w = fromMaybe mempty $ do @@ -101,31 +99,32 @@ targetRBCreatureDraw _ it _ w = fromMaybe mempty $ do thecolor | _tgActive $ _itTargeting it = red | otherwise = blue -targetCursorUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting) -targetCursorUpdate _ _ w t - | SDL.ButtonRight `S.member` _mouseButtons w = (,) w $ t +targetUpdateWith :: (World -> Targeting -> Targeting) + -> Item -> Creature -> World -> Targeting -> (World,Targeting) +targetUpdateWith f _ _ w t = (w, f w t) + +targetCursorUpdate :: World -> Targeting -> Targeting +targetCursorUpdate w t + | SDL.ButtonRight `S.member` _mouseButtons w = t & tgPos . _Just .~ mouseWorldPos w & tgActive .~ True - | otherwise = (,) w $ t & tgPos %~ const Nothing + | otherwise = t & tgPos %~ const Nothing & tgActive .~ False -targetRBPressUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting) -targetRBPressUpdate _ _ w t - | SDL.ButtonRight `S.member` _mouseButtons w = (w,t +targetRBPressUpdate :: World -> Targeting -> Targeting +targetRBPressUpdate w t + | SDL.ButtonRight `S.member` _mouseButtons w = t & tgPos %~ maybe (Just $ mouseWorldPos w) Just & tgActive .~ True - ) - | otherwise = (w,t & tgPos %~ const Nothing + | otherwise = t & tgPos %~ const Nothing & tgActive .~ False - ) -targetRBCreatureUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting) -targetRBCreatureUpdate _ _ w t +targetRBCreatureUpdate :: World -> Targeting -> Targeting +targetRBCreatureUpdate w t | SDL.ButtonRight `S.member` _mouseButtons w && isJust (t ^? tgID . _Just) - = (w,t & updatePos + = t & updatePos & tgActive .~ True - ) - | otherwise = (,) w $ t & tgID .~ fmap _crID (creatureNearPointI 3 mwp w) + | otherwise = t & tgID .~ fmap _crID (creatureNearPointI 3 mwp w) & updatePos & tgActive .~ False where @@ -134,31 +133,13 @@ targetRBCreatureUpdate _ _ w t posFromMaybeID Nothing = Nothing posFromMaybeID (Just i) = w ^? creatures . ix i . crPos -targetLaserDraw :: Int -> Item -> Creature -> World -> Picture -targetLaserDraw _ it _ _ = mempty --- fromMaybe mempty $ do --- ps <- it ^? itTargeting . tgPoints --- return $ setLayer 1 $ pictures --- [ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 5 ps --- , setDepth 19.5 . color (brightX 5 1 col) $ thickLine 1 ps --- ] --- where --- wpammo = _itConsumption it --- reloadFrac --- | _ammoLoaded wpammo == 0 = 1 --- | otherwise = case _reloadState wpammo of --- Just' rs -> fromIntegral rs / fromIntegral (_reloadTime wpammo) --- Nothing' -> 1 --- col = mixColors reloadFrac (1-reloadFrac) red green targetLaserUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting) -targetLaserUpdate _ cr w t +targetLaserUpdate it cr w t | crIsAiming cr = (addLaserPic w,t & tgPos .~ fmap fst mp - & tgPoints .~ sp:ps & tgActive .~ True ) | otherwise = (w,t & tgPos %~ const Nothing - & tgPoints .~ [] & tgActive .~ False ) where @@ -167,8 +148,15 @@ targetLaserUpdate _ cr w t ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp) addLaserPic = instantParticles .:~ Particle { _ptDraw = const $ setLayer 1 $ pictures - [ setDepth 19 . color (brightX 0 0.5 red) $ thickLine 5 (sp:ps) - , setDepth 19.5 . color (brightX 5 1 red) $ thickLine 1 (sp:ps) + [ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 5 (sp:ps) + , setDepth 19.5 . color (brightX 5 1 col) $ thickLine 1 (sp:ps) ] , _ptUpdate = ptSimpleTime 1 } + wpammo = _itConsumption it + reloadFrac + | _ammoLoaded wpammo == 0 = 1 + | otherwise = case _reloadState wpammo of + Just' rs -> fromIntegral rs / fromIntegral (_reloadTime wpammo) + Nothing' -> 1 + col = mixColors reloadFrac (1-reloadFrac) blue red diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 1b271f87b..be1cce431 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -201,7 +201,8 @@ gameRoomsFromRooms = fmap gameRoomFromRoom gameRoomFromRoom :: Room -> GameRoom gameRoomFromRoom rm = GameRoom { _grViewpoints = map doshift $ _rmViewpoints rm ++ (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm) - , _grViewpointsEx = concatMap unpos (_rmPos rm) + ++ mapMaybe filterUnusedLinks (_rmPos rm) + , _grViewpointsEx = concatMap filterUsedLinks (_rmPos rm) , _grBound = map doshift $ expandPolyCorners 50 . convexHullSafe . nubBy closePoints . concat $ _rmBound rm ++ _rmPolys rm , _grDir = getDir $ _rmPos rm @@ -214,9 +215,11 @@ gameRoomFromRoom rm = GameRoom [p +.+ 10 *.* unitVectorAtAngle a ,p -.- 10 *.* unitVectorAtAngle a ] - unpos (UsedOutLink _ _ p a) = doubleShift p a - unpos (UsedInLink _ p a) = doubleShift p a - unpos _ = [] + filterUnusedLinks (UnusedLink p _) = Just p + filterUnusedLinks _ = Nothing + filterUsedLinks (UsedOutLink _ _ p a) = doubleShift p a + filterUsedLinks (UsedInLink _ p a) = doubleShift p a + filterUsedLinks _ = [] undir (UsedOutLink _ _ _ a) = Just $ 0.5*pi + a + snd (_rmShift rm) undir (UsedInLink _ _ a) = Just $ 0.5*pi + a + snd (_rmShift rm) undir _ = Nothing diff --git a/src/Dodge/LockAndKey.hs b/src/Dodge/LockAndKey.hs index e378325ec..1595b16ef 100644 --- a/src/Dodge/LockAndKey.hs +++ b/src/Dodge/LockAndKey.hs @@ -6,6 +6,7 @@ import Dodge.Room import Dodge.RandomHelp import Dodge.Creature import Dodge.Item.Craftable +import Dodge.Item.Weapon.BulletGun.Rod --import Dodge.Item.Equipment import System.Random @@ -15,7 +16,7 @@ lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State lockRoomKeyItems = [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] ) ,(const slowDoorRoomRunPast, return MINIGUN) --- ,(longRoom or something, [sniper]) + ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD]) ] itemRooms :: RandomGen g => [(CombineType, State g (SubCompTree Room))] @@ -39,6 +40,10 @@ itemRooms = ,roomsContaining $ map makeTypeCraft [DRUM,DRUM,PLATE] ] ) + , (SNIPERRIFLE , join $ takeOne + [roomsContaining [sniperRifle] + ] + ) ] roomsContaining :: RandomGen g => [Item] -> State g (SubCompTree Room) diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs index 54d7c55e1..89ac5974d 100644 --- a/src/Dodge/PlacementSpot.hs +++ b/src/Dodge/PlacementSpot.hs @@ -27,6 +27,15 @@ unusedSpotAwayFromInLink x = PSPos f (const id) Nothing where inlinkposs = usedRoomInLinkPoss r +unusedSpotNearInLink :: Float -> PlacementSpot +unusedSpotNearInLink x = PSPos f (const id) Nothing + where + f rp r = case rp of + UnusedSpot p a | any ( ( Just (PS p a,UsedSpot p a) + _ -> Nothing + where + inlinkposs = usedRoomInLinkPoss r + usedRoomInLinkPoss :: Room -> [Point2] usedRoomInLinkPoss r = mapMaybe f $ _rmPos r where diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 51f0beca8..a70495e9f 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -11,6 +11,7 @@ module Dodge.Room , module Dodge.Room.Door , module Dodge.Room.Airlock , module Dodge.Room.LongDoor + , module Dodge.Room.LongRoom , module Dodge.Room.Branch , module Dodge.Room.Teleport , module Dodge.Room.Start @@ -33,3 +34,4 @@ import Dodge.Room.Link import Dodge.Room.Door import Dodge.Room.Airlock import Dodge.Room.LongDoor +import Dodge.Room.LongRoom diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 62fb0636c..1d39483f9 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -21,11 +21,11 @@ import Dodge.Creature import Dodge.LightSource import Picture import Geometry +import LensHelp import qualified Data.Set as S import Data.Tree import System.Random -import Control.Lens import Control.Monad.State --import Data.Tree import qualified Data.IntMap as IM @@ -95,14 +95,12 @@ southPillarsRoom x y h = do addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room addSouthPillars x h r = do let pillarsa = [] - pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20) - ++ putBlockRect (2*x/5-20) (2*x/5+20) (h/2-20) (h/2+20) - ++ putBlockRect (3*x/5-20) (3*x/5+20) (h/2-20) (h/2+20) - ++ putBlockRect (4*x/5-20) (4*x/5+20) (h/2-20) (h/2+20) + pillarsb = concat [putBlockRect (i*x/5-20) (i*x/5+20) (h/2-20) (h/2+20) + | i <- map fromIntegral [1..4::Int]] pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20) ++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20) pillars <- takeOne [pillarsa, pillarsb, pillarsc] - return $ r & rmPmnts %~ (++ pillars) + return $ r & rmPmnts .++~ pillars addButtonSlowDoor :: RandomGen g => Float -> Float -> Room -> State g Room addButtonSlowDoor x h rm = do @@ -111,10 +109,9 @@ addButtonSlowDoor x h rm = do ,( V2 (x/2+50) 5,0::Float) ] thePlacement <- takeOne [butDoor butPos butRot ] - shuffleLinks $ setOutLinksPD aboveH $ setInLinksPD belowH (rm - & rmPmnts %~ (thePlacement :) - & rmBound %~ (openDoorBound :) - ) + shuffleLinks $ setOutLinksPD aboveH $ setInLinksPD belowH $ rm + & rmPmnts .:~ thePlacement + & rmBound .:~ openDoorBound where openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2) belowH y = (sndV2 . fst) y < h - 40 @@ -149,9 +146,7 @@ slowDoorRoom = do slowDoorRoomRunPast :: RandomGen g => State g (SubCompTree Room) slowDoorRoomRunPast = do r <- slowDoorRoom - return $ treeFromTrunk [PassDown door] - (Node (PassDown r) - [ singleUseAll door - , return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink) - ] - ) + return $ treeFromTrunk [PassDown door] $ Node (PassDown r) + [ singleUseAll door + , return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink) + ] diff --git a/src/Dodge/Room/LongRoom.hs b/src/Dodge/Room/LongRoom.hs new file mode 100644 index 000000000..b9d01f450 --- /dev/null +++ b/src/Dodge/Room/LongRoom.hs @@ -0,0 +1,60 @@ +module Dodge.Room.LongRoom where +import Dodge.RoomLink +import Dodge.Tree +--import Dodge.Default.Room +import Dodge.Default.Wall +import Dodge.LevelGen.Data +import Dodge.Placement.Instance +--import Dodge.Room.Link +import Dodge.Room.Door +import Dodge.Room.Corridor +import Dodge.Room.Procedural +--import Dodge.Layout.Tree.Either +--import Dodge.LevelGen.Data +--import Dodge.LevelGen.Switch +import Dodge.RandomHelp +import Dodge.Creature.Inanimate +import Dodge.Creature +--import Dodge.LightSource +--import Picture +import Geometry +import LensHelp +import Data.Tile + +import qualified Data.Set as S +import Data.Tree +import System.Random +import Control.Monad.State +--import Data.Tree +--import qualified Data.IntMap as IM + +longRoom :: RandomGen g => State g Room +longRoom = do + h <- state $ randomR (1500,1500) + let w = 75 + let cond x = (sndV2 . fst) x < h - 40 + let wlsNSEWs wln wls listew = [sps0 $ PutWall (rectNSWE wln wls wallw walle) defaultCrystalWall + | (wallw,walle) <- listew ] + let ws = wlsNSEWs (h-35) (h-135) [(-10,10) , (15,35) , (40,60) , (65,85)] + let wsDefense = wlsNSEWs 95 70 [(0,25) , (50,75) ] + brlN <- state $ randomR (0,5) + brlOffsets <- replicateM brlN $ randInRect (w-20) 900 + let brls = [ sPS (p +.+ V2 10 200) 0 $ PutCrit explosiveBarrel | p <- brlOffsets ] + let rm = roomRect w (h+70) 1 1 & rmPolys .++~ [rectNSWE h (h-165) (-45) (w+45)] + & rmFloor .~ InheritFloor + return $ restrictInLinks cond $ rm & rmPmnts .~ ws ++ brls ++ wsDefense ++ + [sPS (V2 crx (h-25)) 0 $ PutCrit longCrit + | crx <- [12.5,37.5,62.5] ] ++ + [sPS (V2 25 lampy ) 0 putLamp | lampy <- [20,h-10] ] + +longRoomRunPast :: RandomGen g => State g (SubCompTree Room) +longRoomRunPast = do + r <- longRoom + return $ treeFromTrunk [PassDown door] + (Node (PassDown r) + [ singleUseAll door + --, return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink) + , treeFromPost [PassDown $ corridor & rmConnectsTo .~ S.singleton InLink, PassDown corridor] + (UseLabel 0 $ door) + ] + ) diff --git a/src/Dodge/Room/RezBox.hs b/src/Dodge/Room/RezBox.hs index 6bfb9b6e2..4052ad304 100644 --- a/src/Dodge/Room/RezBox.hs +++ b/src/Dodge/Room/RezBox.hs @@ -25,6 +25,7 @@ import Dodge.Item.Random --import Geometry.Data import Geometry import Padding +import LensHelp --import Color --import Shape @@ -32,7 +33,6 @@ import qualified Data.Set as S --import Data.Maybe import Data.Tree import Control.Monad.State -import Control.Lens import System.Random rezBox :: LightSource -> Room @@ -90,24 +90,23 @@ rezBoxesWpCrit = do adddoor rm = treeFromPost [PassDown $ door & rmConnectsTo .~ S.singleton (OnEdge North)] (PassDown rm) crAdd :: Room -> Room -crAdd = rmPmnts %~ (sPS (V2 20 10) (0.5*pi) randC1 :) +crAdd = rmPmnts .:~ sPS (V2 20 10) (0.5*pi) randC1 rezBoxes :: RandomGen g => State g (SubCompTree Room) rezBoxes = do w <- state $ randomR (100,400) h <- state $ randomR (40,40) thecol <- rezColor - let bottomEdgeTest (V2 _ y,_) = y < 1 - dbox = treeFromPost [PassDown door] (PassDown $ rezInvBox thecol) - centralRoom <- shuffleLinks $ setInLinksPD bottomEdgeTest - ((roomRectAutoLinks w h) {_rmPmnts = []}) - let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmLinks centralRoom --- let centralRoom' = restrictOutLinks bottomEdgeTest centralRoom + let bottomEdgeTest = S.member (OnEdge South) . _rlType + dbox = treeFromPost [PassDown $ door & rmConnectsTo .~ S.singleton (OnEdge South)] + (PassDown $ rezInvBox thecol) + centralRoom <- shuffleLinks $ (roomRectAutoLinks w h) {_rmPmnts = []} + & rmLinks %~ setInLinks bottomEdgeTest + let n = length $ filter bottomEdgeTest $_rmLinks centralRoom return $ treeFromTrunk [PassDown $ rezBox thecol , PassDown door ] (Node (PassDown centralRoom) (replicate (n-1) dbox ++ [Node (UseAll door) []])) - rezColor :: RandomGen g => State g LightSource rezColor = do diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 40da49bcf..6121df048 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -303,15 +303,12 @@ weaponBehindPillar = do weaponBetweenPillars :: RandomGen g => State g (SubCompTree Room) weaponBetweenPillars = do - wpPos <- takeOne [V2 x y | x <- [20,120,220], y <- [20,120,220]] - critPlacementSpots <- replicateM 2 $ randDirPS $ unusedSpotAwayFromInLink 100 - let plmnts = - sPS wpPos 0 (RandPS randFirstWeapon) : - map (`sps` randC1) critPlacementSpots - theRoom = roomPillars & rmPmnts %~ (++ plmnts) - (fmap singleUseAll . randomiseOutLinks) =<< filterLinks f theRoom - where - f (_,a) = a == 0 + let wpPos = unusedSpotNearInLink 100 + ncrits <- state $ randomR (1,3) + critPlacementSpots <- replicateM ncrits $ randDirPS $ unusedSpotAwayFromInLink 100 + let theRoom = roomPillars & rmPmnts .++~ + sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots + return $ singleUseAll theRoom weaponLongCorridor :: RandomGen g => State g (SubCompTree Room) weaponLongCorridor = do @@ -356,24 +353,6 @@ roomCCrits :: RandomGen g => State g Room roomCCrits = roomC 200 200 <&> rmPmnts %~ (replicate 20 (spNoID (PSRoomRand 0 (uncurry PS)) randC1) ++ ) -longRoom :: RandomGen g => State g Room -longRoom = do - h <- state $ randomR (1500,1500) - let w = 75 - let cond x = (sndV2 . fst) x < h - 40 - let wlsNSEWs wln wls listew = [sps0 $ PutWall (rectNSWE wln wls wallw walle) defaultCrystalWall - | (wallw,walle) <- listew ] - let ws = wlsNSEWs (h-35) (h-135) [(-10,10) , (15,35) , (40,60) , (65,85)] - let wsDefense = wlsNSEWs 95 70 [(0,25) , (50,75) ] - brlOffsets <- replicateM 5 $ randInRect (w-20) 900 - let brls = [ sPS (p +.+ V2 10 200) 0 $ PutCrit explosiveBarrel | p <- brlOffsets ] - let rm = roomRect w (h+70) 1 1 & rmPolys .++~ [rectNSWE h (h-165) (-45) (w+45)] - & rmFloor .~ InheritFloor - return $ restrictInLinks cond $ rm & rmPmnts .~ ws ++ brls ++ wsDefense ++ - [sPS (V2 crx (h-25)) 0 $ PutCrit longCrit - | crx <- [12.5,37.5,62.5] ] ++ - [sPS (V2 25 lampy ) 0 putLamp | lampy <- [20,h-10] ] - doubleCorridorBarrels :: RandomGen g => State g Room doubleCorridorBarrels = do h <- state $ randomR (200,300) diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index cefdebe06..f0f468fbc 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -174,6 +174,7 @@ setViewDistance :: Configuration -> World -> World setViewDistance cfig w = w & viewDistance .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom w +-- TODO consider adding visible/nearby creatures as view points farWallDist :: Point2 -> Configuration -> World -> Float farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps where