61 lines
2.2 KiB
Haskell
61 lines
2.2 KiB
Haskell
module Dodge.Room.Pillar where
|
|
import Dodge.Data
|
|
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 Geometry
|
|
import LensHelp
|
|
|
|
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' - 9
|
|
h = h' - 9
|
|
tl = V2 (-w) h
|
|
tr = V2 w h
|
|
br = V2 w (-h)
|
|
bl = V2 (-w) (-h)
|
|
aline = PutLineBlock baseBlockPane StoneBlock 9 9
|
|
|
|
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 StoneBlock 9 9
|
|
|
|
|
|
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 (S.member RoomPosOffPath . _rpType) $ _rmPos rm
|
|
let plmnts = -- sps0 (PutShape $ colorSH black $ girderV 96 20 10 (V2 0 120) (V2 w 120))
|
|
-- : sps0 (PutShape $ colorSH black $ girderV 96 20 10 (V2 220 h) (V2 220 (h/2 + 10)))
|
|
-- : sps0 (PutShape $ colorSH black $ girderV 96 20 10 (V2 120 0) (V2 120 (h/2 - 10)))
|
|
-- : sps (PS (V2 20 120) 0) (PutLS $ lsColPos 0.75 (V3 0 0 90))
|
|
-- : sps (PS (V2 (w - 20) 120) 0) (PutLS $ lsColPos 0.75 (V3 0 0 90))
|
|
-- : sps (PS (V2 220 (h-20)) 0) (PutLS $ lsColPos 0.75 (V3 0 0 90))
|
|
-- : sps (PS (V2 120 20) 0) (PutLS $ lsColPos 0.75 (V3 0 0 90))
|
|
replicate npillars (blockPillar (0.5*pilw) (0.5*pilh) & plSpot .~ rprBool
|
|
(\rp _ -> RoomPosOffPath `S.member` _rpType rp
|
|
&& _rpPlacementUse rp == 0
|
|
&& _rpLinkStatus rp == NotLink )
|
|
)
|
|
addGirderLights $ rm
|
|
& rmPmnts .~ plmnts
|
|
& rmName .~ "rectPillars"
|
|
where
|
|
pilw = (( w - 40 * (fromIntegral wn +1) ) / fromIntegral wn) - pillarsize
|
|
pilh = (( h - 40 * (fromIntegral hn +1) ) / fromIntegral hn) - pillarsize
|