justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add indexed world modifications, example use in flicker lights

Browse Source
This commit is contained in:
justin
2021-11-17 11:24:40 +00:00
parent 559d7e3a23
commit 9db091597d
10 changed files with 110 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+11
View File
@@ -70,6 +70,7 @@ data World = World
, _randGen :: StdGen
, _mousePos :: !Point2
, _testString :: World -> [String]
, _modifications :: IM.IntMap Modification
, _yourID :: !Int
, _worldEvents :: World -> World
, _pressPlates :: IM.IntMap PressPlate
@@ -484,6 +485,15 @@ data PjParam = PjParam
, _pjMaxParam :: Int
, _pjDisplayParam :: Int -> String
}
data Modification
= ModIDTimerPoint3Bool
{ _mdID :: Int
, _mdExternalID :: Int
, _mdUpdate :: Modification -> World -> World
, _mdTimer :: Int
, _mdPoint3 :: Point3
, _mdBool :: Bool
}
data Prop
= Projectile
{ _pjPos :: Point2
@@ -792,6 +802,7 @@ makeLenses ''FloorItem
makeLenses ''Ammo
makeLenses ''PjParam
makeLenses ''Prop
makeLenses ''Modification
makeLenses ''Particle
makeLenses ''Wall
makeLenses ''WallStructure
src/Dodge/Default/World.hs
+1
View File
@@ -26,6 +26,7 @@ defaultWorld = World
, _cameraRot = 0
, _cameraZoom = 1
, _cameraViewFrom = V2 0 0
, _modifications = IM.empty
, _creatures = IM.empty
, _creaturesZone = Zone IM.empty
, _creatureGroups = IM.empty
src/Dodge/Initialisation.hs
+1 -1
View File
@@ -31,7 +31,7 @@ initialWorld = defaultWorld
, _yourID = 0
, _worldEvents = saveWorldInEmptySlot LevelStartSlot
. soundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing
. foldr ((.) . makeStartCloudAt) id [V3 x y 5 | x <- [-5,-3..5] , y <- [-5,-3..5]]
. foldr ((.) . makeStartCloudAt) id [V3 x y 5 | x <- [-5,-4..5] , y <- [-5,-4..5]]
, _pressPlates = IM.empty
, _buttons = IM.empty
, _toPlaySounds = M.empty
src/Dodge/LevelGen.hs
+7 -1
View File
@@ -7,11 +7,17 @@ import Dodge.Data
import Dodge.Floor
import Dodge.Layout
import Dodge.Initialisation
import Dodge.RandomHelp
import System.Random
import Control.Lens
import Control.Monad.State
generateWorldFromSeed :: Int -> IO World
generateWorldFromSeed i = do
roomList <- layoutLevelFromSeed 0 i
return $ generateLevelFromRoomList roomList
return $ randomCompass $ generateLevelFromRoomList roomList
initialWorld{_randGen=mkStdGen i}
randomCompass :: World -> World
randomCompass w = w & cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w)
src/Dodge/LevelGen/Data.hs
+3 -2
View File
@@ -22,6 +22,7 @@ data PSType = PutCrit {_unPutCrit :: Creature}
| PutPressPlate PressPlate
| PutBlock [Int] Color [Point2]
| PutCoordinate Point2
| PutMod Modification
| PutTrigger (World -> Bool)
| PutLineBlock Wall Float Float Point2 Point2
| PutWall { _pwPoly :: [Point2] , _pwWall :: Wall }
@@ -104,8 +105,8 @@ spNoID ps pst = Placement ps pst Nothing (const Nothing)
pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement
pContID ps pt = Placement ps pt Nothing . intPlPlPl
plCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement
plCont ps pt = Placement ps pt Nothing
psPtCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement
psPtCont ps pt = Placement ps pt Nothing
sPS :: Point2 -> Float -> PSType -> Placement
sPS p a pt = Placement (PS p a) pt Nothing (const Nothing)
src/Dodge/Placement/Instance/Button.hs
+3 -3
View File
@@ -14,7 +14,7 @@ import Data.Maybe
import Control.Lens
triggerSwitchSPic :: (Button -> SPic) -> PlacementSpot -> Placement
triggerSwitchSPic sdraw ps = plCont ps (PutTrigger (const False))
triggerSwitchSPic sdraw ps = psPtCont ps (PutTrigger (const False))
$ \tp -> Just $ pContID ps (PutButton (makeSwitchSPic sdraw (oneff $ trigid tp) (offeff $ trigid tp)))
(const Nothing)
where
@@ -23,7 +23,7 @@ triggerSwitchSPic sdraw ps = plCont ps (PutTrigger (const False))
offeff tid = triggers . ix tid .~ const False
triggerSwitchSPicLight :: (Button -> SPic) -> PlacementSpot -> Placement
triggerSwitchSPicLight sdraw ps = plCont ps (PutTrigger (const False))
triggerSwitchSPicLight sdraw ps = psPtCont ps (PutTrigger (const False))
$ \tp -> Just $ pContID fstLnkOut (PutLS thels)
$ \lsid -> Just
$ pContID ps (PutButton (makeSwitchSPic sdraw (oneff lsid $ trigid tp) (offeff lsid $ trigid tp)))
@@ -37,7 +37,7 @@ triggerSwitchSPicLight sdraw ps = plCont ps (PutTrigger (const False))
offeff lsid tid = eff lsid tid False (V3 0.5 0 0)
triggerSwitch :: Color -> PlacementSpot -> Placement
triggerSwitch col ps = plCont ps (PutTrigger (const False))
triggerSwitch col ps = psPtCont ps (PutTrigger (const False))
$ \tp -> Just $ pContID ps (PutButton (makeSwitch col col (oneff $ trigid tp) (offeff $ trigid tp)))
(const Nothing)
where
src/Dodge/Placement/Instance/LightSource.hs
+6
View File
@@ -101,6 +101,12 @@ unusedLnkToPS rp = case rp of
UnusedLink p a -> Just $ PS p a
_ -> Nothing
spanLSLightI :: LightSource -> Float -> Point2 -> Point2 -> Placement
spanLSLightI ls h a b = ps0j (PutLS ls {_lsPos = V3 x y h})
$ sps0 $ PutForeground $ thinHighBar h a b
where
V2 x y = 0.5 *.* (a +.+ b)
spanColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement
spanColLightI col h a b = ps0j (PutLS $ colorLightAt col (V3 x y (h-5)) 0)
$ sps0 $ PutForeground $ thinHighBar h a b
src/Dodge/Placement/PlaceSpot.hs
+1
View File
@@ -90,6 +90,7 @@ shiftPSBy (pos,rot) ps = ps
placeSpotID :: PlacementSpot -> PSType -> World -> (Int, World)
placeSpotID ps pt w = case pt of
PutTrigger cond -> placeNewInto triggers cond w
PutMod modi -> plNewUpID modifications mdID modi w
PutProp prop -> plNewUpID props pjID (mvProp p rot prop) w
PutButton bt -> plNewUpID buttons btID (mvButton p rot bt) w
PutFlIt itm -> plNewUpID floorItems flItID (createFlIt p rot itm) w
src/Dodge/Room/Start.hs
+71 -25
View File
@@ -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 ++)
src/Dodge/Update.hs
+6
View File
@@ -58,6 +58,7 @@ functionalUpdate w = case _menuLayers w of
. updateDoors
. resetWorldEvents
. dbArg _worldEvents
. updateModifications
. updateParticles
. updateProjectiles
. updateLightSources
@@ -82,6 +83,11 @@ functionalUpdate w = case _menuLayers w of
where
(x,y) = cloudZoneOfPoint $ stripZ $ _clPos cl
updateModifications :: World -> World
updateModifications w = foldr f w (_modifications w)
where
f md = _mdUpdate md md
splinterBlock :: Block -> World -> World
splinterBlock bl w = foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardCen w (_blWallIDs bl)
& blocks . ix (_blID bl) . blHPs %~ tail