102 lines
3.6 KiB
Haskell
102 lines
3.6 KiB
Haskell
module Dodge.Room.Pillar where
|
|
import Dodge.Default.Block
|
|
import Dodge.Placement.Instance.LightSource
|
|
import Dodge.Data
|
|
import Dodge.Cleat
|
|
import Dodge.PlacementSpot
|
|
import Dodge.Room.Modify.Girder
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Placement.Instance
|
|
--import Dodge.LevelGen.Data
|
|
import Dodge.Room.Procedural
|
|
import Dodge.Room.Link
|
|
import Geometry
|
|
import LensHelp
|
|
import RandomHelp
|
|
|
|
--import Control.Monad.State
|
|
--import System.Random
|
|
import qualified Data.Set as S
|
|
|
|
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
|
|
|
|
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' - 10
|
|
h = h' - 10
|
|
aline = PutLineBlock baseBlockPane
|
|
|
|
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
|
|
let 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 .~ plmnts
|
|
& rmName .~ "rectPillars"
|
|
where
|
|
pilw = (( w - 40 * (fromIntegral wn +1) ) / fromIntegral wn) - pillarsize
|
|
pilh = (( h - 40 * (fromIntegral hn +1) ) / fromIntegral hn) - pillarsize
|