module Dodge.Room.Modify.Girder ( addGirderLights, addGirderFrom, addHighGirder, addHighGirder', addGirderEW, addGirderNS, addGirderNS', ) where import Color import Data.List (nub) import Data.Maybe import qualified Data.Set as S import Dodge.Data.GenWorld import Dodge.LevelGen.PlacementHelper import Dodge.LightSource import Dodge.PlacementSpot import Dodge.Room.Foreground import Geometry import LensHelp import RandomHelp import Shape addGirderNS :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room addGirderNS shapef col room = do let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room girderPosOrder <- shuffle [1 .. nwestlnks - 2] return $ room & rmPmnts .:~ foldr1 setFallback ( sps0 PutNothing : [ twoRoomPoss (isUnusedLnkType (FromEdge West i)) (isUnusedLnkType (FromEdge West i)) $ \ps1 ps2 -> sps0 $ putShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) | i <- girderPosOrder ] ) addGirderFrom :: CardinalPoint -> Int -> (Point2 -> Point2 -> Shape) -> Color -> Room -> Room addGirderFrom cp fromi shapef col = rmPmnts .:~ foldr1 setFallback [ sps0 PutNothing , twoRoomPoss rmposcond rmposcond $ \ps1 ps2 -> sps0 $ putShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) ] where rmposcond = isUnusedLnkType (FromEdge cp fromi) -- | Allows girder to be on edge addGirderNS' :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room addGirderNS' shapef col room = do let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room girderPosOrder <- shuffle [0 .. nwestlnks - 1] return $ room & rmPmnts .:~ foldr1 setFallback ( sps0 PutNothing : [ twoRoomPoss (isUnusedLnkType (FromEdge West i)) (isUnusedLnkType (FromEdge West i)) $ \ps1 ps2 -> sps0 $ putShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) | i <- girderPosOrder ] ) addGirderEW :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room addGirderEW shapef col room = do let nwestlnks = length $ filter ((OnEdge West `S.member`) . _rlType) $ _rmLinks room girderPosOrder <- shuffle [1 .. nwestlnks - 2] return $ room & rmPmnts .:~ foldr1 setFallback ( sps0 PutNothing : [ twoRoomPoss (isUnusedLnkType (FromEdge South i)) (isUnusedLnkType (FromEdge South i)) $ \ps1 ps2 -> sps0 $ putShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) | i <- girderPosOrder ] ) -- TODO add a central light to this, with mounted light fallback? addGirder :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room addGirder shapef col room = do let nslnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room ewlnks = length $ filter ((OnEdge East `S.member`) . _rlType) $ _rmLinks room nsgirds = girdson (FromEdge East) nslnks ewgirds = girdson (FromEdge North) ewlnks girders <- shuffle $ nsgirds ++ ewgirds return $ room & rmPmnts .:~ foldr1 setFallback (sps0 PutNothing : girders) where girdson f numlnks = [ twoRoomPoss (isUnusedLnkType (f i)) (isUnusedLnkType (f i)) $ \ps1 ps2 -> sps0 $ putShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) | i <- [1 .. numlnks - 2] ] addGirder' :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room addGirder' shapef col room = do let nslnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room ewlnks = length $ filter ((OnEdge East `S.member`) . _rlType) $ _rmLinks room nsgirds = girdson (FromEdge East) nslnks ewgirds = girdson (FromEdge North) ewlnks girders <- shuffle $ nsgirds ++ ewgirds return $ room & rmPmnts .:~ foldr1 setFallback (sps0 PutNothing : girders) where girdson f numlnks = [ twoRoomPoss (isUnusedLnkType (f i)) (isUnusedLnkType (f i)) $ \ps1 ps2 -> sps0 $ putShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) | i <- [0 .. numlnks - 1] ] addHighGirder :: RandomGen g => Room -> State g Room addHighGirder r = do gsize <- takeOne [(20, 10), (30, 10), (40, 10), (30, 15)] hgshape <- takeOne $ map (\f -> uncurry (f 96) gsize) [girder, girderZ, girderV] addGirder hgshape black r addHighGirder' :: RandomGen g => Room -> State g Room addHighGirder' r = do gsize <- takeOne [(20, 10), (30, 10), (40, 10), (30, 15)] hgshape <- takeOne $ map (\f -> uncurry (f 96) gsize) [girder, girderZ, girderV] addGirder' hgshape black r randomLightPositions :: RandomGen g => Room -> State g [(Int, Int)] randomLightPositions rm = do let rmtype = _rmType rm xs <- shuffle [0 .. _numLinkEW rmtype] ys <- shuffle [0 .. _numLinkNS rmtype] let n = max (length xs) (length ys) return $ take n $ zip (xs ++ xs) (ys ++ ys) intsToPos :: Room -> (Int, Int) -> Point2 intsToPos rm (x, y) = V2 (20 + _linkGapEW rmtype * fromIntegral x) (20 + _linkGapNS rmtype * fromIntegral y) where rmtype = _rmType rm wiToFloat :: Room -> Int -> Float wiToFloat rm wi = 20 + _linkGapEW (_rmType rm) * fromIntegral wi hiToFloat :: Room -> Int -> Float hiToFloat rm hi = 20 + _linkGapNS (_rmType rm) * fromIntegral hi addGirderLights :: RandomGen g => Room -> State g Room addGirderLights rm = do lpis <- randomLightPositions rm let rmtype = _rmType rm lps = map (intsToPos rm) lpis midi = _numLinkEW rmtype `div` 2 w = _rmWidth rmtype h = _rmHeight rmtype midw = wiToFloat rm midi extragirderpos = nub $ map (\(wi, hi) -> (wi - midi, hi)) lpis extragirders = mapMaybe ( \(i, hi) -> case i of x | x < 0 -> Just $ girderV' 96 20 10 (V2 (midw - 10) (hiToFloat rm hi)) (V2 0 (hiToFloat rm hi)) x | x > 0 -> Just $ girderV' 96 20 10 (V2 (midw + 10) (hiToFloat rm hi)) (V2 w (hiToFloat rm hi)) _ -> Nothing ) extragirderpos return $ rm & rmPmnts .++~ ( sps0 (PutForeground $ girderV' 96 20 10 (V2 midw 0) (V2 midw h)) : map (\p -> sps (PS p 0) (PutLS $ lsColPos 0.75 (V3 0 0 90))) lps ) ++ map (sps0 . PutForeground) extragirders