130 lines
4.4 KiB
Haskell
130 lines
4.4 KiB
Haskell
module Dodge.Room.Pillar (
|
|
blockPillar,
|
|
roomPillars,
|
|
roomPillarsSquare,
|
|
roomPillarsPassage,
|
|
) where
|
|
|
|
import qualified Data.Set as S
|
|
import Dodge.Cleat
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Default.Block
|
|
import Dodge.LevelGen.PlacementHelper
|
|
import Dodge.Placement.Instance
|
|
import Dodge.PlacementSpot
|
|
import Dodge.Room.Link
|
|
import Dodge.Room.Modify.Girder
|
|
import Dodge.Room.Procedural
|
|
import Geometry
|
|
import LensHelp
|
|
import RandomHelp
|
|
|
|
blockPillar :: Float -> Float -> Placement
|
|
blockPillar w' h' =
|
|
ps0jPushPS (aline tl tr) $
|
|
ps0jPushPS (aline tr br) $
|
|
ps0jPushPS (aline br bl) $
|
|
sps0 (aline bl tl)
|
|
where
|
|
w = w' - 10
|
|
h = h' - 10
|
|
tl = V2 (- w) h
|
|
tr = V2 w h
|
|
br = V2 w (- h)
|
|
bl = V2 (- w) (- h)
|
|
aline = PutLineBlock baseBlockPane 9
|
|
|
|
smallPillar :: PSType
|
|
smallPillar = PutBlock defaultBlock baseBlockPane $ reverse $ square 5
|
|
|
|
--crossPillar :: Float -> Float -> Placement
|
|
--crossPillar w' h' =
|
|
-- ps0jPushPS (aline (V2 (- w) 0) (V2 w 0)) $
|
|
-- sps0 (aline (V2 0 (- h)) (V2 0 h))
|
|
-- where
|
|
-- w = w' - 9
|
|
-- h = h' - 9
|
|
-- aline = PutLineBlock baseBlockPane 9
|
|
|
|
roomPillarsSquare :: RandomGen g => State g Room
|
|
roomPillarsSquare = do
|
|
let rm' = roomRectAutoLinks 300 300
|
|
nlew = _numLinkEW (_rmType rm')
|
|
nlns = _numLinkNS (_rmType rm')
|
|
addlights <-
|
|
takeOne
|
|
[ return
|
|
. set
|
|
rmPmnts
|
|
[ mntLS
|
|
vShape
|
|
(rotateVAround (V2 150 150) a (V2 30 30))
|
|
(onXY (rotateVAround (V2 150 150) a) $ V3 60 60 95)
|
|
| a <- [0, pi / 2, pi, 3 * pi / 2]
|
|
]
|
|
, return
|
|
. set
|
|
rmPmnts
|
|
[ mntLS
|
|
vShape
|
|
(rotateVAround (V2 150 150) a (V2 150 0))
|
|
(onXY (rotateVAround (V2 150 150) a) $ V3 150 20 95)
|
|
| a <- [0, pi / 2, pi, 3 * pi / 2]
|
|
]
|
|
, addGirderLights . set rmPmnts []
|
|
, return
|
|
. ( rmPmnts
|
|
.++~ [ spanColLightBlackI 0.75 95 (V2 0 130) (V2 300 130)
|
|
, spanColLightBlackI 0.75 95 (V2 0 170) (V2 300 170)
|
|
, mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
|
|
]
|
|
)
|
|
]
|
|
rm <- addlights rm'
|
|
shuffleLinks $
|
|
rm & rmPmnts .++~ concatMap (replicate nlew . makepill) [South, North]
|
|
++ concatMap (replicate nlns . makepill) [East, West]
|
|
where
|
|
makepill edge = sps (rprBool $ \rp _ -> t edge rp) smallPillar
|
|
t edge rp = any (f edge) (_rpType rp) && _rpPlacementUse rp == 0
|
|
f edge rpt = maybe False (PathFromEdge edge 0 `S.member`) (rpt ^? offPathFromEdges)
|
|
|
|
roomPillarsPassage :: RandomGen g => State g Room
|
|
roomPillarsPassage = do
|
|
let rm = roomRect 100 300 1 3
|
|
shuffleLinks $
|
|
rm & rmPmnts
|
|
.~ [ mntLS iShape (V2 50 0) (V3 50 10 90)
|
|
, mntLS iShape (V2 50 300) (V3 50 290 90)
|
|
, mntLS iShape (V2 0 150) (V3 10 150 90)
|
|
, mntLS iShape (V2 100 150) (V3 90 150 90)
|
|
]
|
|
++ [sPS (V2 30 y) 0 smallPillar | y <- [50, 90 .. 250]]
|
|
++ [sPS (V2 70 y) 0 smallPillar | y <- [50, 90 .. 250]]
|
|
|
|
roomPillars :: RandomGen g => Float -> Float -> Float -> Int -> Int -> State g Room
|
|
roomPillars pillarsize w h wn hn = do
|
|
let rm = roomRect w h wn hn
|
|
npillars = length $ filter rpIsOffPath $ _rmPos rm
|
|
plmnts =
|
|
replicate
|
|
npillars
|
|
( blockPillar (0.5 * pilw) (0.5 * pilh) & plSpot
|
|
.~ rprBool
|
|
( \rp _ ->
|
|
rpIsOffPath rp
|
|
&& _rpPlacementUse rp == 0
|
|
&& _rpLinkStatus rp == NotLink
|
|
)
|
|
)
|
|
addGirderLights $
|
|
rm
|
|
& cleatSide
|
|
& rmPmnts .~ (testchasm : plmnts)
|
|
& rmName .~ "rectPillars"
|
|
where
|
|
pilw = ((w - 40 * (fromIntegral wn + 1)) / fromIntegral wn) - pillarsize
|
|
pilh = ((h - 40 * (fromIntegral hn + 1)) / fromIntegral hn) - pillarsize
|
|
testchasm = Placement 0 (PS 0 0) (PutChasm (map (+V2 50 120) (rectWH 50 25))) Nothing
|
|
(\_ _ -> Nothing)
|