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

Refactor, try to limit dependencies

Browse Source
This commit is contained in:
justin
2022-07-28 00:59:56 +01:00
parent 8aa5c17ab9
commit 160560af5f
418 changed files with 15104 additions and 13342 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/LongDoor.hs
+121 -92
View File
@@ -1,77 +1,83 @@
--{-# LANGUAGE TupleSections #-}
{- | Rooms containing long doors, probably with a big reveal behind them.
-}
-- | Rooms containing long doors, probably with a big reveal behind them.
module Dodge.Room.LongDoor where
import Dodge.Terminal
import Dodge.Data
import Dodge.Default.Door
import Dodge.LevelGen.Switch
import Data.Maybe
import qualified Data.Set as S
import Dodge.Cleat
import Dodge.RoomLink
import Dodge.Tree
import Dodge.Creature
import Dodge.Data.GenWorld
import Dodge.Default.Door
import Dodge.Default.Room
import Dodge.LevelGen.Data
import Dodge.LightSource
import Dodge.Placement.Instance
import Dodge.PlacementSpot
import Dodge.Room.Link
import Dodge.Room.Door
import Dodge.Room.Link
import Dodge.Room.Procedural
--import Dodge.Layout.Tree.Either
--import Dodge.LevelGen.Data
import Dodge.LevelGen.Switch
import RandomHelp
import Dodge.Creature.Inanimate
import Dodge.Creature
import Dodge.LightSource
import Picture
import Dodge.RoomLink
import Dodge.Terminal
import Dodge.Tree
import Geometry
import LensHelp
--import Shape
import Picture
import RandomHelp
import qualified Data.Set as S
import Data.Maybe
twinSlowDoorRoom
:: Float -- ^ Half width
-> Float -- ^ Half height
-> Float -- ^ Inner width
-> Room
twinSlowDoorRoom w h x = defaultRoom
{ _rmPolys = ps
, _rmLinks = map (uncurry outLink)
[ (V2 w (h/2) , negate $ pi/2)
, (V2 (-w) (h/2) , pi/2) ]
++ [uncurry inLink (V2 0 (-h), pi) ]
, _rmPath = mempty
, _rmPmnts =
[ pContID (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col NoWorldEffect)
$ \btid -> jsps0J (PutSlideDr (thedoor btid) thewall DoorObstacle 1 (V2 x 1) (V2 x h))
$ ps0 (PutSlideDr (thedoor btid) thewall DoorObstacle 1 (V2 (-x) 1) (V2 (-x) h))
$ \did -> jps0' (PutLS (lsColPos (V3 0.75 0 0) (V3 0 (h-1) lampheight)))
$ \lspl -> jsps0 $ PutProp $ addColorChange (fromJust $ _plMID lspl) did $ lampCoverWhen (WdBlDoorMoving did) (V2 0 (h-1)) lampheight
]
, _rmBound = ps
, _rmName = "twinSlowDoorRoom"
, _rmViewpoints = [V2 0 h]
}
twinSlowDoorRoom ::
-- | Half width
Float ->
-- | Half height
Float ->
-- | Inner width
Float ->
Room
twinSlowDoorRoom w h x =
defaultRoom
{ _rmPolys = ps
, _rmLinks =
map
(uncurry outLink)
[ (V2 w (h / 2), negate $ pi / 2)
, (V2 (- w) (h / 2), pi / 2)
]
++ [uncurry inLink (V2 0 (- h), pi)]
, _rmPath = mempty
, _rmPmnts =
[ pContID (PS (V2 0 (h -5)) pi) (PutButton $ makeButton col NoWorldEffect) $
\btid -> jsps0J (PutSlideDr (thedoor btid) thewall DoorObstacle 1 (V2 x 1) (V2 x h)) $
ps0 (PutSlideDr (thedoor btid) thewall DoorObstacle 1 (V2 (- x) 1) (V2 (- x) h)) $
\did -> jps0' (PutLS (lsColPos (V3 0.75 0 0) (V3 0 (h -1) lampheight))) $
\lspl -> jsps0 $ PutProp $ addColorChange (fromJust $ _plMID lspl) did $ lampCoverWhen (WdBlDoorMoving did) (V2 0 (h -1)) lampheight
]
, _rmBound = ps
, _rmName = "twinSlowDoorRoom"
, _rmViewpoints = [V2 0 h]
}
where
thewall = switchWallCol red
wlSpeed = 0.5
addColorChange lsid drid = over prUpdate $ PropUpdateAnd $ PropUpdateIf (WdBlDoorMoving drid)
(PropUpdateLS lsid (PrWdLsSetColor (V3 8 0 0)))
(PropUpdateLS lsid (PrWdLsSetColor 0.7))
addColorChange lsid drid =
over prUpdate $
PropUpdateAnd $
PropUpdateIf
(WdBlDoorMoving drid)
(PropUpdateLS lsid (PrWdLsSetColor (V3 8 0 0)))
(PropUpdateLS lsid (PrWdLsSetColor 0.7))
lampheight = 41
ps =
[rectNSWE h 0 (-w) w
,rectNSWE 20 (-h) (negate x) x
ps =
[ rectNSWE h 0 (- w) w
, rectNSWE 20 (- h) (negate x) x
]
thedoor btid = defaultDoor
& drSpeed .~ wlSpeed
& drTrigger .~ WdBlBtNotOff btid
thedoor btid =
defaultDoor
& drSpeed .~ wlSpeed
& drTrigger .~ WdBlBtNotOff btid
col = dim $ dim $ bright red
twinSlowDoorChasers :: RandomGen g => State g Room
twinSlowDoorChasers = do
ps <- takeN 4 $ [ V2 x y | x <- [-65,65], y <- [20,40 .. 180] ]
ps <- takeN 4 $ [V2 x y | x <- [-65, 65], y <- [20, 40 .. 180]]
let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps
return $ twinSlowDoorRoom 80 200 40 & rmPmnts %~ (plmnts ++)
@@ -81,59 +87,79 @@ southPillarsRoom x y h = addSouthPillars x h (roomRectAutoLinks x y)
addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room
addSouthPillars x h r = do
let pillarsa = []
pillarsb = concat [putBlockRect (i*x/5-20) (i*x/5+20) (h/2-20) (h/2+20) | i <- [1..4] ]
pillarsc = concat [putBlockRect (i*x/3-20) (i*x/3+20) (h/2-20) (h/2+20) | i <- [1,2] ]
pillarsb = concat [putBlockRect (i * x / 5 -20) (i * x / 5 + 20) (h / 2 -20) (h / 2 + 20) | i <- [1 .. 4]]
pillarsc = concat [putBlockRect (i * x / 3 -20) (i * x / 3 + 20) (h / 2 -20) (h / 2 + 20) | i <- [1, 2]]
pillars <- takeOne [pillarsa, pillarsb, pillarsc]
return $ r & rmPmnts .++~ pillars
addButtonSlowDoor :: RandomGen g => Float -> Float -> Room -> State g Room
addButtonSlowDoor x h rm = do
shuffleLinks $ setOutLinksPD aboveH $ setInLinksPD belowH $ rm
& rmPmnts .++~ [butDoor , theterminal]
& rmBound .:~ openDoorBound
shuffleLinks $
setOutLinksPD aboveH $
setInLinksPD belowH $
rm
& rmPmnts .++~ [butDoor, theterminal]
& rmBound .:~ openDoorBound
where
theterminal = putMessageTerminal terminalColor (simpleTermMessage themessage)
& plSpot .~ rprBoolShift (isUnusedLnkType InLink) (shiftByV2 (V2 0 (-10)))
themessage =
["WARNING:"
,"LARGE BIOMASS DETECTED"
theterminal =
putMessageTerminal terminalColor (simpleTermMessage themessage)
& plSpot .~ rprBoolShift (isUnusedLnkType InLink) (shiftByV2 (V2 0 (-10)))
themessage =
[ "WARNING:"
, "LARGE BIOMASS DETECTED"
]
openDoorBound = reverse $ rectNSWE (h + 5) (h - 5) (3*x/2) (-x/2)
openDoorBound = reverse $ rectNSWE (h + 5) (h - 5) (3 * x / 2) (- x / 2)
belowH y = (sndV2 . fst) y < h - 40
aboveH y = (sndV2 . fst) y > h + 40
amountedlight dr xoff mpl = Just . moveLSThen (WdP2fDoorPosition (fromJust $ _plMID dr))
(V3 15 xoff 89) (aShape (V2 15 0) (V3 15 xoff 90))
$ \plls plpr -> Just $ ptCont (PutWorldUpdate (const $ setmount dr plls plpr))
$ const mpl
setmount pldr plls plpr = cWorld . doors . ix (fromJust $ _plMID pldr) . drMounts .++~
[MountedLS (fromJust $ _plMID plls), MountedProp (fromJust $ _plMID plpr)]
amountedlight dr xoff mpl = Just
. moveLSThen
(WdP2fDoorPosition (fromJust $ _plMID dr))
(V3 15 xoff 89)
(aShape (V2 15 0) (V3 15 xoff 90))
$ \plls plpr ->
Just $
ptCont (PutWorldUpdate (const $ setmount dr plls plpr)) $
const mpl
setmount pldr plls plpr =
cWorld . doors . ix (fromJust $ _plMID pldr) . drMounts
.++~ [MountedLS (fromJust $ _plMID plls), MountedProp (fromJust $ _plMID plpr)]
-- TODO make the height of this light source and of other mounted lights
-- be taken from a single consistent source
thewall = switchWallCol red
butDoor = putLitButOnPos col
butDoor = putLitButOnPos
col
(rprBool (isUnusedLnkType InLink))
$ \btplmnt -> Just $ putDoubleDoorThen DoorObstacle thewall (WdBlBtNotOff $ fromJust $ _plMID btplmnt)
30 (V2 0 h) (V2 x h) 2
$ \dr1 dr2 ->
amountedlight dr1 50
$ amountedlight dr1 (-50)
$ amountedlight dr2 50
$ amountedlight dr2 (-50)
Nothing
$ \btplmnt -> Just $
putDoubleDoorThen
DoorObstacle
thewall
(WdBlBtNotOff $ fromJust $ _plMID btplmnt)
30
(V2 0 h)
(V2 x h)
2
$ \dr1 dr2 ->
amountedlight dr1 50 $
amountedlight dr1 (-50) $
amountedlight dr2 50 $
amountedlight
dr2
(-50)
Nothing
col = dim $ light red
slowDoorRoom :: RandomGen g => State g Room
slowDoorRoom = do
x <- state $ randomR (400,800)
y <- state $ randomR (400,800)
h <- state $ randomR (200,min (y-100) 500)
x <- state $ randomR (400, 800)
y <- state $ randomR (400, 800)
h <- state $ randomR (200, min (y -100) 500)
let n = 25
xs <- replicateM n $ state $ randomR (10,x-10)
ys <- replicateM n $ state $ randomR (h+20,y)
rs <- replicateM n $ state $ randomR (0,2*pi)
xs <- replicateM n $ state $ randomR (10, x -10)
ys <- replicateM n $ state $ randomR (h + 20, y)
rs <- replicateM n $ state $ randomR (0, 2 * pi)
let ps = zipWith V2 xs ys
xs' <- replicateM 5 $ state $ randomR (10,x-10)
ys' <- replicateM 5 $ state $ randomR (h+20,y)
xs' <- replicateM 5 $ state $ randomR (10, x -10)
ys' <- replicateM 5 $ state $ randomR (h + 20, y)
let crits = zipWith (\p r -> sPS p r randC1) ps rs
barrels = zipWith (\x' y' -> sPS (V2 x' y') 0 $ PutCrit explosiveBarrel) xs' ys'
proom <- southPillarsRoom x y h
@@ -142,7 +168,10 @@ slowDoorRoom = do
slowDoorRoomRunPast :: RandomGen g => State g (MetaTree Room String)
slowDoorRoomRunPast = do
r <- slowDoorRoom
rToOnward "slowDoorRoomRunPast" $ treeFromTrunk [ door] $ Node r
[ pure $ cleatOnward door
, return (cleatLabel 0 $ door & rmConnectsTo .~ S.member InLink)
]
rToOnward "slowDoorRoomRunPast" $
treeFromTrunk [door] $
Node
r
[ pure $ cleatOnward door
, return (cleatLabel 0 $ door & rmConnectsTo .~ S.member InLink)
]