Fix laser targeting draw when creature offscreen
This commit is contained in:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user