Refactor, try to limit dependencies
This commit is contained in:
+93
-56
@@ -1,92 +1,129 @@
|
||||
module Dodge.Room.Tanks where
|
||||
import Dodge.Data
|
||||
import Dodge.Placement.Instance.Pipe
|
||||
import Color
|
||||
import Dodge.Base.CardinalPoint
|
||||
import Dodge.Data.GenWorld
|
||||
import Dodge.LevelGen.Data
|
||||
import RandomHelp
|
||||
import Dodge.Room.Procedural
|
||||
import Dodge.Room.Foreground
|
||||
import Dodge.Room.Modify.Girder
|
||||
--import Dodge.Room.RoadBlock
|
||||
import Dodge.Placement.Instance
|
||||
import Dodge.Placement.Instance.Pipe
|
||||
import Dodge.Placement.TopDecoration
|
||||
import Dodge.PlacementSpot
|
||||
import Dodge.Base.CardinalPoint
|
||||
--import Padding
|
||||
import Color
|
||||
import Shape
|
||||
import LensHelp
|
||||
import Dodge.Room.Foreground
|
||||
import Dodge.Room.Modify.Girder
|
||||
import Dodge.Room.Procedural
|
||||
import Geometry
|
||||
import LensHelp
|
||||
import RandomHelp
|
||||
import Shape
|
||||
|
||||
--import Data.Maybe
|
||||
--import Data.Tree
|
||||
--import qualified Data.Set as S
|
||||
|
||||
randomTank :: RandomGen g => State g Placement
|
||||
randomTank = takeOne $ map (\f -> f (dim orange) orange)
|
||||
[ tankSquareDec fourEmbossDecoration
|
||||
, tankSquareDec midBarDecoration
|
||||
, tankSquareDec squareDecoration
|
||||
, roundTank
|
||||
, roundTankCross
|
||||
, tankSquareDec plusDecoration
|
||||
]
|
||||
randomTank =
|
||||
takeOne $
|
||||
map
|
||||
(\f -> f (dim orange) orange)
|
||||
[ tankSquareDec fourEmbossDecoration
|
||||
, tankSquareDec midBarDecoration
|
||||
, tankSquareDec squareDecoration
|
||||
, roundTank
|
||||
, roundTankCross
|
||||
, tankSquareDec plusDecoration
|
||||
]
|
||||
|
||||
-- dup with randEdgeTanks?
|
||||
randEdgeTank :: RandomGen g => State g Placement
|
||||
randEdgeTank = do
|
||||
edge <- takeOne cardList
|
||||
basetank <- randomTank
|
||||
return $ basetank
|
||||
& plType . putBlock . blDraw
|
||||
%~ ( \bd -> BlockDraws [bd, BlockDrawBlSh (BlShConst $ colorSH orange (verticalPipe 80
|
||||
<> horPipe 80 0 (70 *.* cardVec edge)))] )
|
||||
-- %~ fmap (<> noPic ( colorSH orange (verticalPipe 80
|
||||
-- <> horPipe 80 0 (70 *.* cardVec edge))))
|
||||
-- 70 is a guess, the true value depends on the distance to the wall
|
||||
& plSpot .~ rprBool (\rp _ -> _rpPlacementUse rp == 0
|
||||
&& rpOffPathFromEdge (PathFromEdge edge 0) rp)
|
||||
return $
|
||||
basetank
|
||||
& plType . putBlock . blDraw
|
||||
%~ ( \bd ->
|
||||
BlockDraws
|
||||
[ bd
|
||||
, BlockDrawBlSh
|
||||
( BlShConst $
|
||||
colorSH
|
||||
orange
|
||||
( verticalPipe 80
|
||||
<> horPipe 80 0 (70 *.* cardVec edge)
|
||||
)
|
||||
)
|
||||
]
|
||||
)
|
||||
-- %~ fmap (<> noPic ( colorSH orange (verticalPipe 80
|
||||
-- <> horPipe 80 0 (70 *.* cardVec edge))))
|
||||
-- 70 is a guess, the true value depends on the distance to the wall
|
||||
& plSpot
|
||||
.~ rprBool
|
||||
( \rp _ ->
|
||||
_rpPlacementUse rp == 0
|
||||
&& rpOffPathFromEdge (PathFromEdge edge 0) rp
|
||||
)
|
||||
|
||||
randEdgeTanks :: RandomGen g => Int -> State g [Placement]
|
||||
randEdgeTanks i = do
|
||||
edge <- takeOne cardList
|
||||
basetank <- randomTank
|
||||
return $ replicate i $ basetank
|
||||
& plType . putBlock . blDraw
|
||||
%~ ( \bd -> BlockDraws [bd, BlockDrawBlSh (BlShConst $ colorSH orange (verticalPipe 80
|
||||
<> horPipe 80 0 (70 *.* cardVec edge)))] )
|
||||
-- 70 is a guess, the true value depends on the distance to the wall
|
||||
& plSpot .~ rprBool (\rp _ -> _rpPlacementUse rp == 0
|
||||
&& rpOffPathFromEdge (PathFromEdge edge 0) rp)
|
||||
return $
|
||||
replicate i $
|
||||
basetank
|
||||
& plType . putBlock . blDraw
|
||||
%~ ( \bd ->
|
||||
BlockDraws
|
||||
[ bd
|
||||
, BlockDrawBlSh
|
||||
( BlShConst $
|
||||
colorSH
|
||||
orange
|
||||
( verticalPipe 80
|
||||
<> horPipe 80 0 (70 *.* cardVec edge)
|
||||
)
|
||||
)
|
||||
]
|
||||
)
|
||||
-- 70 is a guess, the true value depends on the distance to the wall
|
||||
& plSpot
|
||||
.~ rprBool
|
||||
( \rp _ ->
|
||||
_rpPlacementUse rp == 0
|
||||
&& rpOffPathFromEdge (PathFromEdge edge 0) rp
|
||||
)
|
||||
|
||||
tanksPipesRoom :: RandomGen g => State g Room
|
||||
tanksPipesRoom = do
|
||||
w <- state $ randomR (200,300)
|
||||
h <- state $ randomR (200,300)
|
||||
i <- state $ randomR (2,5)
|
||||
w <- state $ randomR (200, 300)
|
||||
h <- state $ randomR (200, 300)
|
||||
i <- state $ randomR (2, 5)
|
||||
tanks <- randEdgeTanks i
|
||||
return $ roomRectAutoLinks w h & rmPmnts .++~ tanks
|
||||
|
||||
tanksRoom :: RandomGen g => [Creature] -> [Item] -> State g Room
|
||||
tanksRoom crs its = do
|
||||
w <- state $ randomR (100,400)
|
||||
h <- state $ randomR (200,400)
|
||||
ntanks <- state $ randomR (3,6)
|
||||
w <- state $ randomR (100, 400)
|
||||
h <- state $ randomR (200, 400)
|
||||
ntanks <- state $ randomR (3, 6)
|
||||
thetank <- randomTank <&> plSpot .~ unusedOffPathAwayFromLink 50
|
||||
let room = roomRectAutoLinks w h
|
||||
let plmnts =
|
||||
let plmnts =
|
||||
map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its
|
||||
++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs
|
||||
++ replicate ntanks thetank
|
||||
++ [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp]
|
||||
-- , sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
|
||||
++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs
|
||||
++ replicate ntanks thetank
|
||||
++ [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp]
|
||||
-- , sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
|
||||
hgshape <- takeOne [girder 96 20 10, girderZ 96 20 10, girderV 96 20 10]
|
||||
addhighgirds <- takeOne $
|
||||
[ addGirderEW hgshape black >=> addGirderEW hgshape black
|
||||
, addGirderEW hgshape black
|
||||
, addGirderNS hgshape black >=> addGirderNS hgshape black
|
||||
, addGirderNS hgshape black
|
||||
] ++ replicate 4 return
|
||||
addhighgirds <-
|
||||
takeOne $
|
||||
[ addGirderEW hgshape black >=> addGirderEW hgshape black
|
||||
, addGirderEW hgshape black
|
||||
, addGirderNS hgshape black >=> addGirderNS hgshape black
|
||||
, addGirderNS hgshape black
|
||||
]
|
||||
++ replicate 4 return
|
||||
lgshape <- takeOne [girder 60 20 10, girderZ 60 20 10, girderV 60 20 10]
|
||||
addlowgirds <- takeOne $ addGirderNS lgshape red : replicate 4 return
|
||||
(addlowgirds >=> addhighgirds) $ room & rmPmnts .++~ plmnts
|
||||
& rmName .~ "tanksRoom"
|
||||
addlowgirds <- takeOne $ addGirderNS lgshape red : replicate 4 return
|
||||
(addlowgirds >=> addhighgirds) $
|
||||
room & rmPmnts .++~ plmnts
|
||||
& rmName .~ "tanksRoom"
|
||||
|
||||
Reference in New Issue
Block a user