Fix laser targeting draw when creature offscreen
This commit is contained in:
@@ -94,10 +94,10 @@ longCrit = defaultCreature
|
||||
, _crStrategy = StrategyActions WatchAndWait [StartSentinelPost]
|
||||
, _crGoal = []
|
||||
}
|
||||
, _crInv = IM.fromList [(0,longGun),(1,medkit 100)]
|
||||
, _crInv = IM.fromList [(0,sniperRifle),(1,medkit 100)]
|
||||
, _crInvSel = 0
|
||||
, _crRad = 10
|
||||
, _crHP = 300
|
||||
, _crHP = 150
|
||||
}
|
||||
multGunCrit :: Creature
|
||||
multGunCrit = defaultCreature
|
||||
@@ -173,9 +173,9 @@ testInventory = IM.fromList $ zip [0..]
|
||||
, makeTypeCraftNum 1 LIGHTER
|
||||
, makeTypeCraftNum 5 TUBE
|
||||
-- , makeTypeCraftNum 5 CREATURESENSOR
|
||||
-- , makeTypeCraftNum 3 PRISM
|
||||
, makeTypeCraftNum 3 DRUM
|
||||
, makeTypeCraftNum 3 PUMP
|
||||
, makeTypeCraftNum 3 PRISM
|
||||
-- , makeTypeCraftNum 3 DRUM
|
||||
-- , makeTypeCraftNum 3 PUMP
|
||||
-- , makeTypeCraftNum 1 MAGNET
|
||||
, makeTypeCraftNum 5 HARDWARE
|
||||
, makeTypeCraftNum 3 SPRING
|
||||
|
||||
@@ -150,10 +150,11 @@ invSideEff cr w = weaponReloadSounds cr
|
||||
itpointer = creatures . ix (_crID cr) . crInv . ix i
|
||||
|
||||
doHeldItemTargeting :: Creature -> World -> World
|
||||
doHeldItemTargeting cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting . tgUpdate of
|
||||
doHeldItemTargeting cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting of
|
||||
Nothing -> w
|
||||
Just f -> w & creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itTargeting
|
||||
%~ f (_crInv cr IM.! _crInvSel cr) cr w
|
||||
Just NoTargeting -> w
|
||||
Just t -> let (w',t') = _tgUpdate t (_crInv cr IM.! _crInvSel cr) cr w t
|
||||
in w' & creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itTargeting .~ t'
|
||||
|
||||
weaponReloadSounds :: Creature -> World -> World
|
||||
weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption of
|
||||
|
||||
+2
-1
@@ -71,6 +71,7 @@ data World = World
|
||||
, _cameraRot :: Float
|
||||
, _cameraZoom :: Float
|
||||
, _cameraViewFrom :: Point2
|
||||
, _viewDistance :: Float
|
||||
, _creatures :: IM.IntMap Creature
|
||||
, _creaturesZone :: Zone (IM.IntMap Creature)
|
||||
, _creatureGroups :: IM.IntMap CrGroupParams
|
||||
@@ -381,7 +382,7 @@ data Targeting
|
||||
= NoTargeting
|
||||
| TargetingOnHeld
|
||||
{ _tgPos :: Maybe Point2
|
||||
, _tgUpdate :: Item -> Creature -> World -> Targeting -> Targeting
|
||||
, _tgUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting)
|
||||
, _tgDraw :: Int -> Item -> Creature -> World -> Picture
|
||||
, _tgID :: Maybe Int
|
||||
, _tgActive :: Bool
|
||||
|
||||
@@ -25,6 +25,7 @@ defaultWorld = World
|
||||
, _cameraRot = 0
|
||||
, _cameraZoom = 1
|
||||
, _cameraViewFrom = V2 0 0
|
||||
, _viewDistance = 1000
|
||||
, _modifications = IM.empty
|
||||
, _creatures = IM.empty
|
||||
, _creaturesZone = Zone IM.empty
|
||||
|
||||
+2
-1
@@ -34,8 +34,9 @@ import System.Random
|
||||
initialAnoTree :: RandomGen g => Tree [Annotation g]
|
||||
initialAnoTree = padSucWithCorridors $ treeFromTrunk
|
||||
[[AnoApplyInt 0 startRoom]
|
||||
, [SpecificRoom shootingRange]
|
||||
, [SpecificRoom $ fmap (return . PassDown) longRoom]
|
||||
, [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]
|
||||
, [SpecificRoom randomChallenges]
|
||||
, [AnoApplyInt 1 lasSensorTurretTest]
|
||||
-- ,[ChainAnos
|
||||
-- [[SetLabel 0 $ return $ roomRectAutoLinks 200 200
|
||||
|
||||
@@ -20,12 +20,13 @@ import Dodge.Item.Weapon.LaserPath
|
||||
--import Dodge.Item.Attachment.Data
|
||||
import Dodge.Picture.Layer
|
||||
import Dodge.Creature.Test
|
||||
import Dodge.WorldEvent.HelperParticle
|
||||
import Picture
|
||||
import Geometry.Vector
|
||||
import Geometry.Data
|
||||
import LensHelp
|
||||
|
||||
import Data.Maybe
|
||||
import Control.Lens
|
||||
import qualified Data.Set as S
|
||||
import qualified SDL
|
||||
{- | Automatically send out radar pulses that detect walls. -}
|
||||
@@ -52,7 +53,7 @@ autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
|
||||
defaultTargeting :: Targeting
|
||||
defaultTargeting = TargetingOnHeld
|
||||
{ _tgPos = Nothing
|
||||
, _tgUpdate = \_ _ _ -> id
|
||||
, _tgUpdate = \_ _ w t -> (w,t)
|
||||
, _tgDraw = \_ _ _ _ -> mempty
|
||||
, _tgID = Nothing
|
||||
, _tgActive = False
|
||||
@@ -100,28 +101,31 @@ targetRBCreatureDraw _ it _ w = fromMaybe mempty $ do
|
||||
thecolor | _tgActive $ _itTargeting it = red
|
||||
| otherwise = blue
|
||||
|
||||
targetCursorUpdate :: Item -> Creature -> World -> Targeting -> Targeting
|
||||
targetCursorUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
|
||||
targetCursorUpdate _ _ w t
|
||||
| SDL.ButtonRight `S.member` _mouseButtons w = t
|
||||
| SDL.ButtonRight `S.member` _mouseButtons w = (,) w $ t
|
||||
& tgPos . _Just .~ mouseWorldPos w
|
||||
& tgActive .~ True
|
||||
| otherwise = t & tgPos %~ const Nothing
|
||||
| otherwise = (,) w $ t & tgPos %~ const Nothing
|
||||
& tgActive .~ False
|
||||
|
||||
targetRBPressUpdate :: Item -> Creature -> World -> Targeting -> Targeting
|
||||
targetRBPressUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
|
||||
targetRBPressUpdate _ _ w t
|
||||
| SDL.ButtonRight `S.member` _mouseButtons w = t
|
||||
| SDL.ButtonRight `S.member` _mouseButtons w = (w,t
|
||||
& tgPos %~ maybe (Just $ mouseWorldPos w) Just
|
||||
& tgActive .~ True
|
||||
| otherwise = t & tgPos %~ const Nothing
|
||||
)
|
||||
| otherwise = (w,t & tgPos %~ const Nothing
|
||||
& tgActive .~ False
|
||||
)
|
||||
|
||||
targetRBCreatureUpdate :: Item -> Creature -> World -> Targeting -> Targeting
|
||||
targetRBCreatureUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
|
||||
targetRBCreatureUpdate _ _ w t
|
||||
| SDL.ButtonRight `S.member` _mouseButtons w && isJust (t ^? tgID . _Just)
|
||||
= t & updatePos
|
||||
= (w,t & updatePos
|
||||
& tgActive .~ True
|
||||
| otherwise = t & tgID .~ fmap _crID (creatureNearPointI 3 mwp w)
|
||||
)
|
||||
| otherwise = (,) w $ t & tgID .~ fmap _crID (creatureNearPointI 3 mwp w)
|
||||
& updatePos
|
||||
& tgActive .~ False
|
||||
where
|
||||
@@ -131,30 +135,40 @@ targetRBCreatureUpdate _ _ w t
|
||||
posFromMaybeID (Just i) = w ^? creatures . ix i . crPos
|
||||
|
||||
targetLaserDraw :: Int -> Item -> Creature -> World -> Picture
|
||||
targetLaserDraw _ it _ _ = 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 -> Targeting
|
||||
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
|
||||
| crIsAiming cr = t
|
||||
| crIsAiming cr = (addLaserPic w,t
|
||||
& tgPos .~ fmap fst mp
|
||||
& tgPoints .~ sp:ps
|
||||
& tgActive .~ True
|
||||
| otherwise = t & tgPos %~ const Nothing
|
||||
)
|
||||
| otherwise = (w,t & tgPos %~ const Nothing
|
||||
& tgPoints .~ []
|
||||
& tgActive .~ False
|
||||
)
|
||||
where
|
||||
(mp, ps) = reflectLaserAlong 0.2 [] sp ep w
|
||||
sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
|
||||
ep = sp +.+ 1000 *.* normalizeV (mouseWorldPos w -.- sp)
|
||||
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)
|
||||
]
|
||||
, _ptUpdate = ptSimpleTime 1
|
||||
}
|
||||
|
||||
@@ -171,7 +171,7 @@ jsps :: Point2 -> Float -> PSType -> Maybe Placement
|
||||
jsps p a pst = Just $ Placement (PS p a) pst Nothing $ const Nothing
|
||||
|
||||
jsps0 :: PSType -> Maybe Placement
|
||||
jsps0 pst = Just $ sPS (V2 0 0) 0 pst
|
||||
jsps0 = Just . sPS (V2 0 0) 0
|
||||
|
||||
sps0 :: PSType -> Placement
|
||||
sps0 = sPS (V2 0 0) 0
|
||||
|
||||
@@ -13,7 +13,6 @@ lightsForGloom w = mapMaybe getLS (IM.elems $ _lightSources w) ++ mapMaybe getTL
|
||||
getLS = getlsparam . _lsParam
|
||||
getTLS = getlsparam . _tlsParam
|
||||
getlsparam ls
|
||||
| dist campos (fst2 $ _lsPos ls) > 1000 = Nothing
|
||||
| dist (_cameraCenter w) (fst2 $ _lsPos ls) > _viewDistance w + _lsRad ls = Nothing
|
||||
| otherwise = Just ( _lsPos ls, _lsRad ls^(2::Int) , _lsCol ls)
|
||||
campos = _cameraCenter w
|
||||
fst2 (V3 a b _) = V2 a b
|
||||
|
||||
@@ -25,6 +25,7 @@ import qualified Data.Map.Strict as M
|
||||
--import Control.Lens
|
||||
--import Data.Maybe
|
||||
|
||||
-- TODO only filter out shapes outside the range of the furthest shown light source
|
||||
worldSPic :: Configuration -> World -> SPic
|
||||
worldSPic cfig w =
|
||||
(extraShapes w, extraPics cfig w)
|
||||
@@ -35,13 +36,13 @@ worldSPic cfig w =
|
||||
<> foldMap mcSPic (filtOn _mcPos _machines)
|
||||
where
|
||||
filtOn f g = IM.filter (pointIsClose . f) (g w)
|
||||
pointIsClose p = dist camCen p < winSize
|
||||
winSize = 30 + max (_windowX cfig) (_windowY cfig)
|
||||
pointIsClose p = dist camCen p < 30 + _viewDistance w
|
||||
camCen = _cameraCenter w
|
||||
|
||||
extraShapes :: World -> Shape
|
||||
extraShapes = _foregroundShape
|
||||
|
||||
-- TODO filter out pictures not in the frame
|
||||
extraPics :: Configuration -> World -> Picture
|
||||
extraPics cfig w = pictures (_decorations w)
|
||||
<> concatMapPic (dbArg _ptDraw) (_particles w)
|
||||
@@ -53,7 +54,6 @@ extraPics cfig w = pictures (_decorations w)
|
||||
<> viewBoundaries cfig w
|
||||
<> drawPathing cfig w
|
||||
|
||||
-- TODO remove duplicate!
|
||||
testPic :: World -> Picture
|
||||
testPic _ = []
|
||||
clDraw :: Cloud -> Picture
|
||||
@@ -73,7 +73,7 @@ mcSPic bt = uncurryV translateSPf (_mcPos bt)
|
||||
$ rotateSP (_mcDir bt) (_mcDraw bt bt)
|
||||
|
||||
soundPics :: Configuration -> World -> Picture
|
||||
soundPics cfig w
|
||||
soundPics cfig w
|
||||
| _show_sound cfig = pictures $ M.map (soundPic cfig w) $ _playingSounds w
|
||||
| otherwise = []
|
||||
|
||||
|
||||
@@ -14,7 +14,6 @@ module Dodge.Room.Link
|
||||
, randomiseAllLinks
|
||||
, shuffleLinks
|
||||
, filterLinks
|
||||
, changeLinkTo
|
||||
, randomiseOutLinks
|
||||
, chooseOneInLink
|
||||
, restrictRMInLinksPD
|
||||
@@ -78,43 +77,10 @@ shuffleLinks r = do
|
||||
newLinks <- shuffle $ _rmLinks r
|
||||
return $ r {_rmLinks = newLinks }
|
||||
|
||||
--randomiseLinksBy
|
||||
-- :: ( [(Point2,Float)] -> State g [(Point2,Float)] )
|
||||
-- -> Room
|
||||
-- -> State g Room
|
||||
--randomiseLinksBy f r = do
|
||||
-- newLinks <- f $ _rmOutLinks r ++ _rmInLinks r
|
||||
-- return $ r {_rmOutLinks = init newLinks
|
||||
-- , _rmInLinks = [last newLinks]
|
||||
-- }
|
||||
|
||||
filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
|
||||
filterLinks cond r = do
|
||||
newLinks <- shuffle $ filter (cond . lnkPosDir) $ _rmLinks r
|
||||
return $ r {_rmLinks = newLinks}
|
||||
{- | Swaps the last link in the list with one that satisfies a given
|
||||
- property (it might swap with itself). Unsafe.
|
||||
- Be careful about calling this after changeLinkFrom. -}
|
||||
-- TODO replace with something more sensible
|
||||
changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
|
||||
changeLinkTo cond r = do
|
||||
let alllinks = _rmLinks r
|
||||
l <- takeOne $ filter (cond . lnkPosDir) alllinks
|
||||
let l' = l & rlType .~ S.singleton InLink
|
||||
let newLinks = delete l alllinks
|
||||
return $ r & rmLinks .~ (l':newLinks)
|
||||
{- | Move a room so that the first link in '_rmInLinks' lines up to
|
||||
an external point and direction.
|
||||
This is intended to work when the external point is an outgoing link from another room.
|
||||
-}
|
||||
--shiftRoomToLink :: (Point2,Float) -> Room -> Room
|
||||
--shiftRoomToLink l r
|
||||
-- = shiftRoomBy l
|
||||
-- . shiftRoomBy (V2 0 0 , pi-a)
|
||||
-- $ shiftRoomBy (V2 0 0 -.- p , 0)
|
||||
-- r
|
||||
-- where
|
||||
-- (p,a) = lnkPosDir $ head $ _rmInLinks r
|
||||
|
||||
doRoomShift :: Room -> Room
|
||||
doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm
|
||||
|
||||
+32
-50
@@ -22,8 +22,8 @@ import Dodge.Room.Airlock
|
||||
import Geometry
|
||||
import Tile
|
||||
import MonadHelp
|
||||
import LensHelp
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad.State
|
||||
--import Control.Monad.Loops
|
||||
import System.Random
|
||||
@@ -142,40 +142,30 @@ glassSwitchBackCrits = glassSwitchBack
|
||||
] ++)
|
||||
|
||||
miniTree2 :: RandomGen g => State g (SubCompTree Room)
|
||||
miniTree2 = restrictInLinks (\p -> (sndV2 . fst) p < 70) <$> glassSwitchBackCrits
|
||||
>>= randomiseAllLinks
|
||||
miniTree2 = (glassSwitchBackCrits
|
||||
>>= randomiseAllLinks . restrictInLinks (\p -> (sndV2 . fst) p < 70))
|
||||
<&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)
|
||||
|
||||
miniRoom3 :: RandomGen g => State g (SubCompTree Room)
|
||||
miniRoom3 = do
|
||||
w <- state $ randomR (300,400)
|
||||
h <- state $ randomR (300,400)
|
||||
let cp = V2 0 (h/2+40)
|
||||
let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ map toV2 [(-10,-60)
|
||||
,( 10,-60)
|
||||
,( 10,-80)
|
||||
,(-10,-80)
|
||||
]
|
||||
let plmnts = [sPS cp 0 $ PutCrit miniGunCrit
|
||||
,sPS cp 0 $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
||||
,sPS cp (1*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
||||
,sPS cp (2*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
||||
,sPS cp (3*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
||||
,sPS cp (4*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
||||
,sPS cp (5*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
||||
,sPS cp (6*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
||||
,sPS cp (7*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
||||
,sPS cp (pi/8) b
|
||||
,sPS cp (pi/8+1*pi/4) b
|
||||
,sPS cp (pi/8+2*pi/4) b
|
||||
,sPS cp (pi/8+3*pi/4) b
|
||||
,sPS cp (pi/8+4*pi/4) b
|
||||
,sPS cp (pi/8+5*pi/4) b
|
||||
,sPS cp (pi/8+6*pi/4) b
|
||||
,sPS cp (pi/8+7*pi/4) b
|
||||
,sPS (V2 (w/2) (h/2)) 0 putLamp
|
||||
]
|
||||
fmap singleUseAll $ randomiseOutLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
|
||||
w <- state $ randomR (300,400)
|
||||
h <- state $ randomR (300,400)
|
||||
let cp = V2 0 (h/2+40)
|
||||
let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ map toV2 [(-10,-60)
|
||||
,( 10,-60)
|
||||
,( 10,-80)
|
||||
,(-10,-80)
|
||||
]
|
||||
let plmnts =
|
||||
[ sPS cp (fromIntegral i*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
||||
| i <- [0..7::Int]
|
||||
] ++
|
||||
[ sPS cp (pi/8+fromIntegral i*pi/4) b
|
||||
| i <- [0..7::Int]
|
||||
] ++
|
||||
[ sPS cp 0 $ PutCrit miniGunCrit
|
||||
, sPS (V2 (w/2) (h/2)) 0 putLamp ]
|
||||
fmap singleUseAll $ randomiseOutLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h
|
||||
|
||||
rot90Around :: Point2 -> Point2 -> Point2
|
||||
rot90Around cen p = cen +.+ vNormal (p -.- cen)
|
||||
@@ -371,26 +361,18 @@ longRoom = do
|
||||
h <- state $ randomR (1500,1500)
|
||||
let w = 75
|
||||
let cond x = (sndV2 . fst) x < h - 40
|
||||
let ws = map (\ps -> sPS (V2 0 0) 0 $ PutWall ps defaultCrystalWall)
|
||||
[rectNSWE (h-35) (h-135) (-10) 10
|
||||
,rectNSWE (h-35) (h-135) 15 35
|
||||
,rectNSWE (h-35) (h-135) 40 60
|
||||
,rectNSWE (h-35) (h-135) 65 85
|
||||
]
|
||||
let wsDefense = map (\ps -> sPS (V2 0 0) 0 $ PutWall ps defaultCrystalWall)
|
||||
[rectNSWE 95 70 0 25
|
||||
,rectNSWE 95 70 50 75
|
||||
]
|
||||
brls <- fmap (map (\p -> sPS (p +.+ V2 10 200) 0 $ PutCrit explosiveBarrel) )
|
||||
$ replicateM 5 $ randInRect (w-20) 900
|
||||
let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
|
||||
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 12.5 (h-25)) 0 $ PutCrit longCrit
|
||||
,sPS (V2 37.5 (h-25)) 0 $ PutCrit longCrit
|
||||
,sPS (V2 62.5 (h-25)) 0 $ PutCrit longCrit
|
||||
,sPS (V2 25 20 ) 0 putLamp
|
||||
,sPS (V2 25 (h-10)) 0 putLamp
|
||||
]
|
||||
[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
|
||||
|
||||
@@ -67,14 +67,14 @@ room2 = lasCenSensEdge
|
||||
startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
|
||||
startRoom i = join $ uncurry takeOneWeighted $ unzip
|
||||
-- [ (,) (0.5::Float) $ chainUses <$> sequence [minigunFakeout,weaponRoom]
|
||||
[-- (,) one rezBoxesWp
|
||||
(,) one rezBoxesThenWeaponRoom
|
||||
-- , (,) 1 rezBoxThenWeaponRoom
|
||||
-- , (,) one rezBoxesWpCrit
|
||||
-- , (,) 1 $ runPastStart i
|
||||
[ (,) one rezBoxesWp
|
||||
, (,) one rezBoxesThenWeaponRoom
|
||||
, (,) 1 rezBoxThenWeaponRoom
|
||||
, (,) one rezBoxesWpCrit
|
||||
, (,) 1 $ runPastStart i
|
||||
]
|
||||
where
|
||||
one = (1::Float)
|
||||
one = 1::Float
|
||||
randomChallenges :: RandomGen g => State g (SubCompTree Room)
|
||||
randomChallenges = join $ takeOne
|
||||
[fmap (return . UseAll) doubleCorridorBarrels
|
||||
|
||||
@@ -16,7 +16,7 @@ getLinksOfType :: RoomLinkType -> [RoomLink] -> [RoomLink]
|
||||
getLinksOfType lt = filter (S.member lt . _rlType)
|
||||
|
||||
restrictInLinks :: ((Point2,Float) -> Bool) -> Room -> Room
|
||||
restrictInLinks f = rmLinks %~ restrictLinkType InLink f
|
||||
restrictInLinks = over rmLinks . restrictLinkType InLink
|
||||
|
||||
restrictOutLinks :: ((Point2,Float) -> Bool) -> Room -> Room
|
||||
restrictOutLinks f = rmLinks %~ restrictLinkType OutLink f
|
||||
|
||||
@@ -28,7 +28,8 @@ import qualified SDL
|
||||
{- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
|
||||
update where your avatar's view is from. -}
|
||||
updateCamera :: Configuration -> World -> World
|
||||
updateCamera cfig = rotateCamera cfig . autoZoomCamera cfig . moveCamera . updateScopeZoom
|
||||
updateCamera cfig = rotateCamera cfig . setViewDistance cfig
|
||||
. autoZoomCamera cfig . moveCamera . updateScopeZoom
|
||||
{- Updte the center of the screen camera center and where your avatar's view is from in world. -}
|
||||
moveCamera :: World -> World
|
||||
moveCamera w = w
|
||||
@@ -169,6 +170,10 @@ autoZoomCamera cfig w = w & cameraZoom %~ changeZoom
|
||||
zoomOutSpeed = 15
|
||||
theScopeZoom = fromMaybe 1 $ yourItem w ^? _Just . itScope . scopeZoom
|
||||
|
||||
setViewDistance :: Configuration -> World -> World
|
||||
setViewDistance cfig w = w & viewDistance
|
||||
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom w
|
||||
|
||||
farWallDist :: Point2 -> Configuration -> World -> Float
|
||||
farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps
|
||||
where
|
||||
|
||||
Reference in New Issue
Block a user