Add indexed world modifications, example use in flicker lights
This commit is contained in:
+71
-25
@@ -1,6 +1,7 @@
|
||||
module Dodge.Room.Start where
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.Data
|
||||
import Dodge.Default
|
||||
import Dodge.Layout.Tree.Either
|
||||
import Dodge.RandomHelp
|
||||
import Dodge.Room.Door
|
||||
@@ -23,24 +24,63 @@ import Data.Tree
|
||||
import Control.Monad.State
|
||||
import Control.Lens
|
||||
import System.Random
|
||||
--import qualified Data.IntMap.Strict as IM
|
||||
import Data.Maybe
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
|
||||
rezBox :: Room
|
||||
rezBox = roomRect 40 60 1 1
|
||||
& rmPmnts .~ [ spanColLightI rezcol 95 (V2 0 1) (V2 40 1) ]
|
||||
rezBox :: LightSource -> Room
|
||||
rezBox ls = roomRect 40 60 1 1
|
||||
& rmPmnts .~ [ sPS (V2 20 1) 0 $ PutLS ls]
|
||||
rezColor :: RandomGen g => State g LightSource
|
||||
rezColor = do
|
||||
col <- takeOne [V3 0.0 0.1 0.5, V3 0.0 0.5 0.1]
|
||||
h <- takeOne [30,50,80,90,90,90,90]
|
||||
rad <- takeOne [150,200,200,250,250,300,300,300]
|
||||
return defaultLS
|
||||
{ _lsPos = V3 0 0 h
|
||||
, _lsIntensity = col
|
||||
, _lsRad = rad
|
||||
}
|
||||
|
||||
rezcol :: Point3
|
||||
rezcol = V3 0.0 0.1 0.5
|
||||
rezInvBox :: LightSource -> Room
|
||||
rezInvBox = (rmLinks %~ reverse) . rezBox
|
||||
|
||||
rezInvBox :: Room
|
||||
rezInvBox = roomRect 40 60 1 1
|
||||
& rmPmnts .~ [ spanColLightI rezcol 95 (V2 0 59) (V2 40 59) ]
|
||||
crAdd :: Room -> Room
|
||||
crAdd = rmPmnts %~ (sPS (V2 20 10) (0.5*pi) randC1 :)
|
||||
|
||||
crRezBox :: Room
|
||||
crRezBox = rezInvBox & rmPmnts %~ (sPS (V2 20 50) (1.5*pi) randC1 :)
|
||||
wpAdd :: Item -> Room -> Room
|
||||
wpAdd wp = rmPmnts %~ f
|
||||
where
|
||||
f (x:xs) = sPS (V2 15 30) 1 (PutFlIt wp) : g x : xs
|
||||
f _ = [sPS (V2 15 30) 1 (PutFlIt wp)]
|
||||
g x = x & plIDCont .~ flickerMod
|
||||
|
||||
wpRezBox :: Item -> Room
|
||||
wpRezBox wp = rezInvBox & rmPmnts %~ (sPS (V2 15 30) 1 (PutFlIt wp) :)
|
||||
-- TODO move this to a sensible place
|
||||
-- Supposes the orginal placement is a light source, adds a flickermod
|
||||
flickerMod :: Placement -> Maybe Placement
|
||||
flickerMod pl = Just $ sps0 $ PutMod $ ModIDTimerPoint3Bool
|
||||
{ _mdID = 0
|
||||
, _mdExternalID = fromJust $ _plMID pl
|
||||
, _mdUpdate = flickerUpdate
|
||||
, _mdTimer = 10
|
||||
, _mdPoint3 = 0.8
|
||||
, _mdBool = True
|
||||
}
|
||||
|
||||
flickerUpdate :: Modification -> World -> World
|
||||
flickerUpdate md w
|
||||
| _mdTimer md > 0 = w & modifications . ix mdid . mdTimer -~ 1
|
||||
| otherwise = w & lightSources . ix lsid . lsIntensity .~ mdcol
|
||||
& modifications . ix mdid
|
||||
%~ ( (mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not) )
|
||||
where
|
||||
mdcol = _mdPoint3 md
|
||||
lscol = _lsIntensity $ _lightSources w IM.! lsid
|
||||
lsid = _mdExternalID md
|
||||
mdid = _mdID md
|
||||
timerange
|
||||
| _mdBool md = (2,10)
|
||||
| otherwise = (2,30)
|
||||
(newtime,_) = randomR timerange $ _randGen w
|
||||
|
||||
rezBoxesThenWeaponRoom :: RandomGen g => State g (Tree (Either Room Room))
|
||||
rezBoxesThenWeaponRoom = do
|
||||
@@ -49,7 +89,9 @@ rezBoxesThenWeaponRoom = do
|
||||
return $ rboxes `appendEitherTree` [wroom]
|
||||
|
||||
rezBoxThenWeaponRoom :: RandomGen g => State g (Tree (Either Room Room))
|
||||
rezBoxThenWeaponRoom = treeFromTrunk [Left rezBox,Left door] <$> weaponRoom
|
||||
rezBoxThenWeaponRoom = do
|
||||
rcol <- rezColor
|
||||
treeFromTrunk [Left $ rezBox rcol,Left door] <$> weaponRoom
|
||||
|
||||
startRoom :: RandomGen g => State g (Tree (Either Room Room))
|
||||
startRoom = join $ takeOne
|
||||
@@ -63,9 +105,11 @@ rezBoxesWpCrit :: RandomGen g => State g (Tree (Either Room Room))
|
||||
rezBoxesWpCrit = do
|
||||
w <- state $ randomR (200,400)
|
||||
h <- state $ randomR (40,40)
|
||||
thecol <- rezColor
|
||||
theweapon <- randBlockBreakWeapon
|
||||
let bottomEdgeTest (V2 _ y,_) = y < 1
|
||||
bottomLeftTest (V2 x y,_) = y < 1 && x < 21
|
||||
aroom = rezInvBox thecol
|
||||
centralRoom <- filterSortOutLinksOn bottomEdgeTest ((\(V2 a b) -> (b,a)) . fst) <$>
|
||||
(randomiseOutLinks =<< changeLinkTo bottomLeftTest
|
||||
((roomRectAutoLinks w h) {_rmPmnts = []}))
|
||||
@@ -74,10 +118,10 @@ rezBoxesWpCrit = do
|
||||
j <- state $ randomR (i,n-2)
|
||||
blcor <- blockedCorridor'
|
||||
let rezrooms = map adddoor
|
||||
$ insertAt i (wpRezBox theweapon)
|
||||
$ insertAt j crRezBox
|
||||
$ replicate (n-3) rezInvBox
|
||||
return $ treeFromTrunk [Left rezBox
|
||||
$ insertAt i (wpAdd theweapon aroom)
|
||||
$ insertAt j (crAdd aroom)
|
||||
$ replicate (n-3) aroom
|
||||
return $ treeFromTrunk [Left $ rezBox thecol
|
||||
, Left door
|
||||
]
|
||||
(Node (Left centralRoom) (rezrooms ++ [onwardtree blcor]))
|
||||
@@ -90,20 +134,21 @@ rezBoxesWp = do
|
||||
w <- state $ randomR (100,400)
|
||||
h <- state $ randomR (40,40)
|
||||
theweapon <- randBlockBreakWeapon
|
||||
thecol <- rezColor
|
||||
let bottomEdgeTest (V2 _ y,_) = y < 1
|
||||
aroom = rezInvBox thecol
|
||||
centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest
|
||||
((roomRectAutoLinks w h) {_rmPmnts = []})
|
||||
blcor <- blockedCorridor'
|
||||
let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
|
||||
let rezrooms = map adddoor
|
||||
$ wpRezBox theweapon : replicate (n-2) rezInvBox
|
||||
$ wpAdd theweapon aroom : replicate (n-2) aroom
|
||||
centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
|
||||
return $ treeFromTrunk [Left rezBox
|
||||
return $ treeFromTrunk [Left $ rezBox thecol
|
||||
, Left door
|
||||
]
|
||||
(Node (Left centralRoom') (rezrooms ++ [onwardtree blcor]))
|
||||
where
|
||||
--dbox = treeFromPost [Left door] (Left rezInvBox)
|
||||
adddoor rm = treeFromPost [Left door] (Left rm)
|
||||
onwardtree blcor = treeFromPost [Left door] (Right blcor)
|
||||
|
||||
@@ -111,17 +156,17 @@ rezBoxes :: RandomGen g => State g (Tree (Either Room Room))
|
||||
rezBoxes = do
|
||||
w <- state $ randomR (100,400)
|
||||
h <- state $ randomR (40,40)
|
||||
thecol <- rezColor
|
||||
let bottomEdgeTest (V2 _ y,_) = y < 1
|
||||
dbox = treeFromPost [Left door] (Left $ rezInvBox thecol)
|
||||
centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest
|
||||
((roomRectAutoLinks w h) {_rmPmnts = []})
|
||||
let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
|
||||
centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
|
||||
return $ treeFromTrunk [Left rezBox
|
||||
return $ treeFromTrunk [Left $ rezBox thecol
|
||||
, Left door
|
||||
]
|
||||
(Node (Left centralRoom') (replicate (n-1) dbox ++ [Node (Right door) []]))
|
||||
where
|
||||
dbox = treeFromPost [Left door] (Left rezInvBox)
|
||||
|
||||
startRoom' :: RandomGen g => State g (Tree (Either Room Room))
|
||||
startRoom' = do
|
||||
@@ -137,7 +182,8 @@ startRoom' = do
|
||||
, putLasTurret & plSpot .~ PS (V2 (0.8*w) (0.8*h)) 0
|
||||
, sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
|
||||
]
|
||||
treeFromPost [Left rezBox, Left door] . Right
|
||||
thecol <- rezColor
|
||||
treeFromPost [Left $ rezBox thecol, Left door] . Right
|
||||
<$> randomiseOutLinks
|
||||
(shiftRoomBy (V2 (-20) (-20),0)
|
||||
( roomRectAutoLinks w h & rmPmnts %~ (plmnts ++)
|
||||
|
||||
Reference in New Issue
Block a user