Simplify and unify block placement
This commit is contained in:
+2
-2
@@ -581,8 +581,8 @@ data PSType = PutCrit Creature
|
||||
| PutPressPlate PressPlate
|
||||
| PutAutoDoor Point2 Point2
|
||||
| PutBlock [Int] Color [Point2]
|
||||
| PutBlockWall [Int] Color [Point2]
|
||||
| PutWindowBlock Point2 Point2
|
||||
-- | PutBlockWall [Int] Color [Point2]
|
||||
| PutLineBlock Wall Float Float Point2 Point2
|
||||
| PutTriggerDoor Color (World -> Bool) Point2 Point2
|
||||
| PutBtDoor Color Point2 Float Point2 Point2
|
||||
| PutSwitchDoor Color Point2 Float Point2 Point2
|
||||
|
||||
@@ -32,6 +32,17 @@ lev1 = do
|
||||
(
|
||||
[return $ return $ Right deadEndRoom
|
||||
]
|
||||
++ [return $ connectRoom corridor
|
||||
,return $ connectRoom door
|
||||
,glassSwitchBack >>= randomiseLinks]
|
||||
++ [return $ connectRoom corridor
|
||||
,return $ connectRoom door]
|
||||
++ [miniRoom3]
|
||||
++ [return $ connectRoom corridor
|
||||
,return $ connectRoom door]
|
||||
++ [roomCCrits]
|
||||
++ [return $ connectRoom corridor
|
||||
,return $ connectRoom door]
|
||||
++[roomMiniIntro]
|
||||
++ [longRoom >>= randomiseLinks]
|
||||
++ [return $ connectRoom corridor
|
||||
|
||||
@@ -16,7 +16,7 @@ import Dodge.Data
|
||||
import Dodge.Base
|
||||
|
||||
import Dodge.LevelGen.Block
|
||||
import Dodge.LevelGen.WindowBlock
|
||||
import Dodge.LevelGen.LineBlock
|
||||
import Dodge.LevelGen.Pathing
|
||||
import Dodge.LevelGen.StaticWalls
|
||||
import Dodge.LevelGen.AutoDoor
|
||||
@@ -73,10 +73,10 @@ placeSpot ps w = case ps of
|
||||
-> addAutoDoor (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
|
||||
|
||||
PS {_psPos = p, _psRot = rot, _psType = PutBlock (hp:hps) col ps}
|
||||
-> putBlock(map (shiftPointBy (p,rot)) ps) hp col False hps w
|
||||
-> putBlock (map (shiftPointBy (p,rot)) ps) hp col False hps w
|
||||
|
||||
PS {_psPos = p, _psRot = rot, _psType = PutBlockWall (hp:hps) col ps}
|
||||
-> putBlockWallPart (map (shiftPointBy (p,rot)) ps) hp col False hps w
|
||||
-- PS {_psPos = p, _psRot = rot, _psType = PutBlockWall (hp:hps) col ps}
|
||||
-- -> putBlockWallPart (map (shiftPointBy (p,rot)) ps) hp col False hps w
|
||||
|
||||
PS {_psPos = p, _psRot = rot, _psType = PutBtDoor c bp f a b}
|
||||
-> addButtonDoor c (shiftPointBy (p,rot) bp) (f + rot)
|
||||
@@ -85,12 +85,11 @@ placeSpot ps w = case ps of
|
||||
-> addSwitchDoor c (shiftPointBy (p,rot) bp) (f + rot)
|
||||
(shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
|
||||
|
||||
PS {_psPos = p, _psRot = rot, _psType = PutWindowBlock a b}
|
||||
-> putWindowBlock' (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
|
||||
PS {_psPos = p, _psRot = rot, _psType = PutLineBlock wl width depth a b}
|
||||
-> putLineBlock wl width depth (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
|
||||
|
||||
PS {_psPos = p, _psRot = rot, _psType = PutWindow { _pwPoly = ps, _pwColor = c }}
|
||||
-> rmCrossPaths $ over walls (addWindow (q:qs) c) w
|
||||
-- where (q:qs) = translateS p $ rotateS rot ps
|
||||
where (q:qs) = map (shiftPointBy (p,rot)) ps
|
||||
rmCrossPaths w = foldr (uncurry removePathsCrossing) w $ zip (q:qs) (qs++[q])
|
||||
|
||||
|
||||
@@ -76,8 +76,7 @@ addBlockNoShadow (p:ps) hp col isSeeThrough degradability hasAllShadows w
|
||||
| hp <= 0 = addBlock (p:ps) (head degradability + hp) col isSeeThrough (tail degradability) w
|
||||
| otherwise = over wallsZone (flip (IM.foldr wallInZone) blocks)
|
||||
$ over walls (IM.union blocks) w
|
||||
--addBlock (p:p':ps) w = over walls (IM.insert i b) w
|
||||
where
|
||||
where
|
||||
shadowList | hasAllShadows = repeat True
|
||||
| otherwise = concat $ repeat [False,True]
|
||||
lines = zip (p:ps) (ps ++ [p])
|
||||
|
||||
@@ -0,0 +1,57 @@
|
||||
module Dodge.LevelGen.LineBlock
|
||||
(putLineBlock
|
||||
)
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Base
|
||||
import Dodge.LevelGen.Pathing
|
||||
|
||||
import Picture
|
||||
import Geometry
|
||||
|
||||
import Control.Lens
|
||||
|
||||
import qualified Data.IntMap as IM
|
||||
|
||||
-- taken from online, splits a list into its even and odd elements
|
||||
evenOddSplit = foldr f ([],[])
|
||||
where f a (ls,rs) = (rs, a : ls)
|
||||
|
||||
putLineBlock :: Wall -> Float -> Float -> Point2 -> Point2 -> World -> World
|
||||
putLineBlock basePane blockWidth depth a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks
|
||||
where
|
||||
d = dist a b
|
||||
rot = argV (b -.- a)
|
||||
psOnLine = divideLineOddNumPoints blockWidth a b
|
||||
halfBlockWidth = d / (fromIntegral $ length psOnLine - 1)
|
||||
blockCenPs = snd $ evenOddSplit psOnLine
|
||||
numBlocks = length blockCenPs
|
||||
is = [0.. numBlocks - 1]
|
||||
cornerPoints = [(-halfBlockWidth,-depth) -- goes anticlockwise around the block
|
||||
,(-halfBlockWidth, depth)
|
||||
,( halfBlockWidth, depth)
|
||||
,( halfBlockWidth,-depth)
|
||||
]
|
||||
cornersAt p = fmap ( (p +.+) . rotateV rot) cornerPoints
|
||||
linesAt p = map (\(a,b) -> [a,b]) $ makeLoopPairs $ cornersAt p
|
||||
k = newKey $ _walls w
|
||||
ksAtI i = map ( + (k + i*4) ) [0,1,2,3]
|
||||
visibilityAt i | i == 0 = [ True,True,False,True]
|
||||
| i == numBlocks - 1 = [False,True, True,True]
|
||||
| otherwise = [False,True,False,True]
|
||||
shadowsAt i | i == 0 = ksAtI 1
|
||||
| i == numBlocks - 1 = ksAtI $ numBlocks - 2
|
||||
| otherwise = ksAtI (i-1) ++ ksAtI (i+1)
|
||||
makeBlockAt :: Point2 -> Int -> [Wall]
|
||||
makeBlockAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
|
||||
makePane i visStatus k' ps
|
||||
= basePane {_wlID = k'
|
||||
,_wlLine = ps
|
||||
,_blIDs = ksAtI i
|
||||
,_blShadows = shadowsAt i
|
||||
,_blVisible = visStatus
|
||||
}
|
||||
listBlocks = concat $ zipWith makeBlockAt blockCenPs is
|
||||
insertBlock :: Wall -> World -> World
|
||||
insertBlock wl = over walls $ IM.insert (_wlID wl) wl
|
||||
|
||||
@@ -1,72 +0,0 @@
|
||||
module Dodge.LevelGen.WindowBlock
|
||||
(putWindowBlock'
|
||||
)
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Base
|
||||
import Dodge.LevelGen.Pathing
|
||||
|
||||
import Picture
|
||||
import Geometry
|
||||
|
||||
import Control.Lens
|
||||
|
||||
import qualified Data.IntMap as IM
|
||||
|
||||
basePane :: Wall
|
||||
basePane = Block
|
||||
{ _wlLine = []
|
||||
, _wlID = 0
|
||||
, _wlColor = withAlpha 0.2 cyan
|
||||
, _wlDraw = Nothing
|
||||
, _wlSeen = False
|
||||
, _blIDs = []
|
||||
, _blHP = 1
|
||||
, _wlIsSeeThrough = True
|
||||
, _blVisible = True
|
||||
, _blShadows = []
|
||||
, _blDegrades = [5,5]
|
||||
}
|
||||
--singleBlock :: [Int] -> IM.IntMap Wall
|
||||
|
||||
-- taken from online, splits a list into its even and odd elements
|
||||
evenOddSplit = foldr f ([],[])
|
||||
where f a (ls,rs) = (rs, a : ls)
|
||||
|
||||
putWindowBlock' :: Point2 -> Point2 -> World -> World
|
||||
putWindowBlock' a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks
|
||||
where d = dist a b
|
||||
rot = argV (b -.- a)
|
||||
psOnLine = divideLineOddNumPoints 9 a b
|
||||
halfBlockWidth = d / (fromIntegral $ length psOnLine - 1)
|
||||
blockCenPs = snd $ evenOddSplit psOnLine
|
||||
numBlocks = length blockCenPs
|
||||
is = [0.. numBlocks - 1]
|
||||
cornerPoints = [(-halfBlockWidth,-9) -- goes anticlockwise around the block
|
||||
,(-halfBlockWidth, 9)
|
||||
,( halfBlockWidth, 9)
|
||||
,( halfBlockWidth,-9)
|
||||
]
|
||||
cornersAt p = fmap ( (p +.+) . rotateV rot) cornerPoints
|
||||
linesAt p = map (\(a,b) -> [a,b]) $ makeLoopPairs $ cornersAt p
|
||||
k = newKey $ _walls w
|
||||
ksAtI i = map ( + (k + i*4) ) [0,1,2,3]
|
||||
visibilityAt i | i == 0 = [ True,True,False,True]
|
||||
| i == numBlocks - 1 = [False,True, True,True]
|
||||
| otherwise = [False,True,False,True]
|
||||
shadowsAt i | i == 0 = ksAtI 1
|
||||
| i == numBlocks - 1 = ksAtI $ numBlocks - 2
|
||||
| otherwise = ksAtI (i-1) ++ ksAtI (i+1)
|
||||
makeBlockAt :: Point2 -> Int -> [Wall]
|
||||
makeBlockAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
|
||||
makePane i visStatus k' ps
|
||||
= basePane {_wlID = k'
|
||||
,_wlLine = ps
|
||||
,_blIDs = ksAtI i
|
||||
,_blShadows = shadowsAt i
|
||||
,_blVisible = visStatus
|
||||
}
|
||||
listBlocks = concat $ zipWith makeBlockAt blockCenPs is
|
||||
insertBlock :: Wall -> World -> World
|
||||
insertBlock wl = over walls $ IM.insert (_wlID wl) wl
|
||||
|
||||
@@ -0,0 +1,58 @@
|
||||
module Dodge.Room.Placement
|
||||
where
|
||||
import Dodge.Data
|
||||
import Picture
|
||||
|
||||
import Geometry
|
||||
|
||||
-- module defining helper placements for rooms
|
||||
|
||||
singleBlock :: Point2 -> [PlacementSpot]
|
||||
singleBlock a = [PS a 0 $ PutBlock [5,20,20] (greyN 0.5)
|
||||
$ reverse $ rectNSWE 10 (-10) (-10) 10]
|
||||
|
||||
blockLine :: Point2 -> Point2 -> PlacementSpot
|
||||
blockLine a b = PS
|
||||
{ _psPos = (0,0)
|
||||
, _psRot = 0
|
||||
, _psType = PutLineBlock baseBlockPane 9 9 a b
|
||||
}
|
||||
|
||||
windowLine :: Point2 -> Point2 -> PlacementSpot
|
||||
windowLine a b = PS
|
||||
{ _psPos = (0,0)
|
||||
, _psRot = 0
|
||||
, _psType = PutLineBlock baseWindowPane 8 8 a b
|
||||
}
|
||||
|
||||
windowLineType :: Point2 -> Point2 -> PSType
|
||||
windowLineType a b = PutLineBlock baseWindowPane 8 8 a b
|
||||
|
||||
baseBlockPane :: Wall
|
||||
baseBlockPane = Block
|
||||
{ _wlLine = []
|
||||
, _wlID = 0
|
||||
, _wlColor = greyN 0.5
|
||||
, _wlDraw = Nothing
|
||||
, _wlSeen = False
|
||||
, _blIDs = []
|
||||
, _blHP = 5
|
||||
, _wlIsSeeThrough = False
|
||||
, _blVisible = True
|
||||
, _blShadows = []
|
||||
, _blDegrades = [20,20]
|
||||
}
|
||||
baseWindowPane :: Wall
|
||||
baseWindowPane = Block
|
||||
{ _wlLine = []
|
||||
, _wlID = 0
|
||||
, _wlColor = withAlpha 0.2 cyan
|
||||
, _wlDraw = Nothing
|
||||
, _wlSeen = False
|
||||
, _blIDs = []
|
||||
, _blHP = 1
|
||||
, _wlIsSeeThrough = True
|
||||
, _blVisible = True
|
||||
, _blShadows = []
|
||||
, _blDegrades = [5,5]
|
||||
}
|
||||
+63
-104
@@ -12,6 +12,8 @@ import Dodge.Layout
|
||||
import Dodge.LightSources
|
||||
import Dodge.SoundLogic
|
||||
|
||||
import Dodge.Room.Placement
|
||||
|
||||
import Geometry
|
||||
import Picture
|
||||
|
||||
@@ -137,7 +139,7 @@ roomC x y = Room
|
||||
{ _rmPolys = [rectNSWE y 0 0 x]
|
||||
, _rmLinks = lnks
|
||||
, _rmPath = []
|
||||
, _rmPS = [PS (0,0) 0 $ PutWindowBlock (x/2,0) (x/2,y-60)
|
||||
, _rmPS = [windowLine (x/2,0) (x/2,y-60)
|
||||
]
|
||||
--, _rmBound = rectNSWE y 0 0 x
|
||||
, _rmBound = []
|
||||
@@ -216,45 +218,45 @@ roomPillars :: Room
|
||||
roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect' 240 240 2 2
|
||||
where plmnts = g 180 150 90 60
|
||||
f a x b y = putBlockRect a x b y
|
||||
-- putWallBlocks (a,b) (a,y)
|
||||
-- ++ putWallBlocks (a,y) (x,y)
|
||||
-- ++ putWallBlocks (x,y) (x,b)
|
||||
-- ++ putWallBlocks (x,b) (a,b)
|
||||
g a b c d = f a b a b ++ f a b c d ++ f c d a b ++ f c d c d
|
||||
|
||||
|
||||
putBlockRect a x b y = putWallBlocks (a,b) (a,y)
|
||||
++ putWallBlocks (a,y) (x,y)
|
||||
++ putWallBlocks (x,y) (x,b)
|
||||
++ putWallBlocks (x,b) (a,b)
|
||||
putBlockV a x b y = putWallBlocks (a,b) (a,y)
|
||||
++ putWallBlocks (x,b) (a,b)
|
||||
putBlockC a x b y = putWallBlocks (a,b) (a,y)
|
||||
++ putWallBlocks (x,b) (a,b)
|
||||
++ putWallBlocks (a,y) (x,y)
|
||||
putBlockN a x b y = putWallBlocks (a,b) (a,y)
|
||||
++ putWallBlocks (x,b) (a,b)
|
||||
++ putWallBlocks (x,y) (x,b)
|
||||
putBlockRect a x b y = [ blockLine (a,b) (a,y)
|
||||
, blockLine (a,y) (x,y)
|
||||
, blockLine (x,y) (x,b)
|
||||
, blockLine (x,b) (a,b)
|
||||
]
|
||||
putBlockV a x b y = [ blockLine (a,b) (a,y)
|
||||
, blockLine (x,b) (a,b)
|
||||
]
|
||||
putBlockC a x b y = [ blockLine (a,b) (a,y)
|
||||
, blockLine (x,b) (a,b)
|
||||
, blockLine (a,y) (x,y)
|
||||
]
|
||||
putBlockN a x b y = [ blockLine (a,b) (a,y)
|
||||
, blockLine (x,b) (a,b)
|
||||
, blockLine (x,y) (x,b)
|
||||
]
|
||||
|
||||
branchWith :: Room -> [Tree Room] -> Tree (Either Room Room)
|
||||
branchWith r ts = Node (Left r) $ [return $ Right door] ++ fmap (fmap Left) ts
|
||||
|
||||
glassSwitchBack :: RandomGen g => State g Room
|
||||
glassSwitchBack = do
|
||||
wth <- state $ randomR (200,400)
|
||||
hgt <- state $ randomR (400,600)
|
||||
wllen <- state $ randomR (60,wth/2-40)
|
||||
let hf = hgt/5
|
||||
let plmnts = [PS (0,0) 0 $ PutWindowBlock (wth-60, hf) (wllen,hf)
|
||||
,PS (0,0) 0 $ PutWindowBlock (wth-wllen,2*hf) (60, 2*hf)
|
||||
,PS (0,0) 0 $ PutWindowBlock (wth-60, 3*hf) (wllen,3*hf)
|
||||
,PS (0,0) 0 $ PutWindowBlock (wth-wllen,4*hf) (60, 4*hf)
|
||||
]
|
||||
++ putWallBlocks ( 0, 1*hf) (wllen,1*hf)
|
||||
++ putWallBlocks (wth-wllen, 2*hf) ( wth,2*hf)
|
||||
++ putWallBlocks ( 0, 3*hf) (wllen,3*hf)
|
||||
++ putWallBlocks (wth-wllen, 4*hf) ( wth,4*hf)
|
||||
return $ set rmPS plmnts $ roomRect' wth hgt 2 6
|
||||
wth <- state $ randomR (200,400)
|
||||
hgt <- state $ randomR (400,600)
|
||||
wllen <- state $ randomR (60,wth/2-40)
|
||||
let hf = hgt/5
|
||||
let plmnts = [windowLine (wth-60, hf) (wllen,hf)
|
||||
,windowLine (wth-wllen,2*hf) (60, 2*hf)
|
||||
,windowLine (wth-60, 3*hf) (wllen,3*hf)
|
||||
,windowLine (wth-wllen,4*hf) (60, 4*hf)
|
||||
,blockLine ( 0, 1*hf) (wllen,1*hf)
|
||||
,blockLine (wth-wllen, 2*hf) ( wth,2*hf)
|
||||
,blockLine ( 0, 3*hf) (wllen,3*hf)
|
||||
,blockLine (wth-wllen, 4*hf) ( wth,4*hf)
|
||||
]
|
||||
return $ set rmPS plmnts $ roomRect' wth hgt 2 6
|
||||
|
||||
manyDoors :: Int -> Tree (Either Room Room)
|
||||
manyDoors i = treePost (replicate i (Left door)) $ Right door
|
||||
@@ -273,7 +275,7 @@ glassLesson = do
|
||||
,PS (50,100) 0 $ PutCrit miniGunCrit
|
||||
,PS (50,50) 0 basicLS
|
||||
]
|
||||
topplmnts = [PS (0,0) 0 $ PutWindowBlock (100,200) (100,0)
|
||||
topplmnts = [windowLine (100,200) (100,0)
|
||||
,PS (50,100) 0 $ PutCrit miniGunCrit
|
||||
,PS (50,50) 0 basicLS
|
||||
]
|
||||
@@ -289,18 +291,18 @@ miniRoom1 = do
|
||||
,50+4*hf,30+5*hf
|
||||
]
|
||||
crx <- state $ randomR (wllen,wth-(wllen+40))
|
||||
let plmnts = [PS (0,0) 0 $ PutWindowBlock (wth-60, 40+hf) (wllen,40+hf)
|
||||
,PS (0,0) 0 $ PutWindowBlock (wth-wllen,40+2*hf) (60,40+2*hf)
|
||||
,PS (0,0) 0 $ PutWindowBlock (wth-60, 40+3*hf) (wllen,40+3*hf)
|
||||
,PS (0,0) 0 $ PutWindowBlock (wth-wllen,40+4*hf) (60,40+4*hf)
|
||||
let plmnts = [windowLine (wth-60, 40+hf) (wllen,40+hf)
|
||||
,windowLine (wth-wllen,40+2*hf) (60,40+2*hf)
|
||||
,windowLine (wth-60, 40+3*hf) (wllen,40+3*hf)
|
||||
,windowLine (wth-wllen,40+4*hf) (60,40+4*hf)
|
||||
,PS (crx,cry) 0 $ PutCrit miniGunCrit
|
||||
,PS (wth-20,hgt/2+40) 0 $ randC
|
||||
,PS (wth/2,hgt/2) 0 basicLS
|
||||
,blockLine ( 0, 40+1*hf) (wllen,40+1*hf)
|
||||
,blockLine (wth-wllen, 40+2*hf) ( wth,40+2*hf)
|
||||
,blockLine ( 0, 40+3*hf) (wllen,40+3*hf)
|
||||
,blockLine (wth-wllen, 40+4*hf) ( wth,40+4*hf)
|
||||
]
|
||||
++ putWallBlocks ( 0, 40+1*hf) (wllen,40+1*hf)
|
||||
++ putWallBlocks (wth-wllen, 40+2*hf) ( wth,40+2*hf)
|
||||
++ putWallBlocks ( 0, 40+3*hf) (wllen,40+3*hf)
|
||||
++ putWallBlocks (wth-wllen, 40+4*hf) ( wth,40+4*hf)
|
||||
return $ set rmPS plmnts $ shiftRoomBy ((0,40),0) $ roomRect' wth hgt 2 4
|
||||
|
||||
miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
|
||||
@@ -312,30 +314,21 @@ miniRoom3 :: RandomGen g => State g (Tree (Either Room Room))
|
||||
miniRoom3 = do
|
||||
w <- state $ randomR (300,400)
|
||||
h <- state $ randomR (300,400)
|
||||
let l = -70
|
||||
let r = 70
|
||||
let cp = (0,h/2+40)
|
||||
let f = rot90Around cp
|
||||
let f2 = f . f
|
||||
let f3 = f . f .f
|
||||
let cpa p = p +.+ cp
|
||||
let bl = putWallBlocks (cpa (-20,-40)) (cpa (-20,-80))
|
||||
let br = putWallBlocks (cpa (20,-40)) (cpa (20,-80))
|
||||
let bm = putWallBlocks (cpa (25,-35)) (cpa (35,-25))
|
||||
let b = PutBlock [5,20,20] (greyN 0.5) [(-10,-60)
|
||||
,( 10,-60)
|
||||
,( 10,-80)
|
||||
,(-10,-80)
|
||||
]
|
||||
let plmnts = [PS cp 0 $ PutCrit miniGunCrit
|
||||
,PS cp 0 $ PutWindowBlock (0,-40) (0,-80)
|
||||
,PS cp (1*pi/4) $ PutWindowBlock (0,-40) (0,-80)
|
||||
,PS cp (2*pi/4) $ PutWindowBlock (0,-40) (0,-80)
|
||||
,PS cp (3*pi/4) $ PutWindowBlock (0,-40) (0,-80)
|
||||
,PS cp (4*pi/4) $ PutWindowBlock (0,-40) (0,-80)
|
||||
,PS cp (5*pi/4) $ PutWindowBlock (0,-40) (0,-80)
|
||||
,PS cp (6*pi/4) $ PutWindowBlock (0,-40) (0,-80)
|
||||
,PS cp (7*pi/4) $ PutWindowBlock (0,-40) (0,-80)
|
||||
,PS cp 0 $ windowLineType (0,-40) (0,-80)
|
||||
,PS cp (1*pi/4) $ windowLineType (0,-40) (0,-80)
|
||||
,PS cp (2*pi/4) $ windowLineType (0,-40) (0,-80)
|
||||
,PS cp (3*pi/4) $ windowLineType (0,-40) (0,-80)
|
||||
,PS cp (4*pi/4) $ windowLineType (0,-40) (0,-80)
|
||||
,PS cp (5*pi/4) $ windowLineType (0,-40) (0,-80)
|
||||
,PS cp (6*pi/4) $ windowLineType (0,-40) (0,-80)
|
||||
,PS cp (7*pi/4) $ windowLineType (0,-40) (0,-80)
|
||||
,PS cp (pi/8) b
|
||||
,PS cp (pi/8+1*pi/4) b
|
||||
,PS cp (pi/8+2*pi/4) b
|
||||
@@ -366,46 +359,15 @@ roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treePost
|
||||
g (Node (Right x) xs) = Node (Left x) $ map g xs
|
||||
g (Node y ys) = Node y $ map g ys
|
||||
|
||||
putSingleBlock :: Point2 -> [PlacementSpot]
|
||||
putSingleBlock a = [PS a 0 $ PutBlock [5,20,20] (greyN 0.5)
|
||||
$ reverse $ rectNSWE 10 (-10) (-10) 10]
|
||||
|
||||
putWallBlocks :: Point2 -> Point2 -> [PlacementSpot]
|
||||
putWallBlocks a b = map (\p -> PS p rot $ PutBlockWall [5,20,20] (greyN 0.5)
|
||||
$ reverse $ rectNSWE 10 (-10) (-10) 10)
|
||||
ps
|
||||
-- ++
|
||||
-- map (\p -> PS p rot $ PutBlockWall [5,20,20] (greyN 0.5)
|
||||
-- $ reverse $ rectNSWE 10 (-10) (-10) 10)
|
||||
-- rs
|
||||
|
||||
where d = dist a b
|
||||
rot = argV (b -.- a)
|
||||
numPoints' = floor (d / 30)
|
||||
numPoints = numPoints'*2 + 1
|
||||
ns = take (numPoints + 1) [0..]
|
||||
ps = map (\i -> a +.+ i/ (fromIntegral numPoints) *.* (b -.- a))
|
||||
$ map fromIntegral ns
|
||||
ps' = map (\i -> au +.+ i/ (fromIntegral numPoints) *.* (bu -.- au))
|
||||
$ map fromIntegral ns
|
||||
|
||||
rs = map (\i -> ad +.+ i/ (fromIntegral numPoints) *.* (bd -.- ad))
|
||||
$ map fromIntegral ns
|
||||
norm = normalizeV $ vNormal $ b -.- a
|
||||
au = a +.+ 10 *.* norm
|
||||
bu = b +.+ 10 *.* norm
|
||||
ad = a -.- 10 *.* norm
|
||||
bd = b -.- 10 *.* norm
|
||||
|
||||
|
||||
roomCenterPillar :: RandomGen g => State g Room
|
||||
roomCenterPillar = changeLinkTo ((\p -> dist p (120,0) < 10) . fst)
|
||||
$ set rmPS plmnts $ roomRect' 240 240 2 2
|
||||
where plmnts = putWallBlocks (110,110) (110,130)
|
||||
++ putWallBlocks (130,110) (130,130)
|
||||
++ [PS (40,120) 0 basicLS
|
||||
,PS (200,120) 0 basicLS
|
||||
]
|
||||
where plmnts = [ blockLine (110,110) (110,130)
|
||||
, blockLine (130,110) (130,130)
|
||||
, PS (40,120) 0 basicLS
|
||||
, PS (200,120) 0 basicLS
|
||||
]
|
||||
|
||||
roomOctogon :: Room
|
||||
roomOctogon = Room
|
||||
@@ -654,8 +616,8 @@ shooterRoom :: RandomGen g => State g Room
|
||||
shooterRoom = do
|
||||
h <- state $ randomR (200,300)
|
||||
let cond x = (snd . fst) x < h - 40
|
||||
changeLinkTo cond $ set rmPS ( putWallBlocks (50,50) (50,h) ++
|
||||
[PS ( 25,h-25) 0 $ PutCrit $ addArmour autoCrit
|
||||
changeLinkTo cond $ set rmPS ( [blockLine (50,50) (50,h)
|
||||
,PS ( 25,h-25) 0 $ PutCrit $ addArmour autoCrit
|
||||
,PS ( 75,h-30) 0 $ PutCrit explosiveBarrel
|
||||
,PS ( 75,h-60) 0 $ PutCrit explosiveBarrel
|
||||
,PS ( 85,h-10) 0 $ PutCrit explosiveBarrel
|
||||
@@ -709,13 +671,11 @@ shootersRoom = do
|
||||
|
||||
pistolerRoom :: RandomGen g => State g Room
|
||||
pistolerRoom = do
|
||||
let f2 x y = putSingleBlock (x,y)
|
||||
-- let f2 x y = [PS (x,y) 0 $ PutWindow (rectNSEW 40 0 0 40) $ withAlpha 0.5 aquamarine]
|
||||
f3 x y = putWallBlocks (x-20,y) (x+20,y)
|
||||
++ putWallBlocks (x,y-20) (x,y+20)
|
||||
f4 x y = putWallBlocks (x-20,y-20) (x+20,y+20)
|
||||
++ putWallBlocks (x+20,y-20) (x-20,y+20)
|
||||
--f <- takeOne [f2,f3,f4]
|
||||
let f2 x y = singleBlock (x,y)
|
||||
f3 x y = [blockLine (x-20,y) (x+20,y)
|
||||
,blockLine (x,y-20) (x,y+20) ]
|
||||
f4 x y = [blockLine (x-20,y-20) (x+20,y+20)
|
||||
,blockLine (x+20,y-20) (x-20,y+20) ]
|
||||
f <- takeOne [f2]
|
||||
h <- state $ randomR (400,800)
|
||||
let w = h
|
||||
@@ -775,10 +735,9 @@ spawnerRoom = do
|
||||
y <- state $ randomR (300,400)
|
||||
wl <- takeOne [PS (0,0) 0 $ PutWindow (rectNSWE (y-60) 0 (x/2-10) (x/2+10))
|
||||
$ withAlpha 0.5 aquamarine
|
||||
,PS (0,0) 0 $ PutWindowBlock (x/2,0) (x/2,y-60)
|
||||
,windowLine (x/2,0) (x/2,y-60)
|
||||
]
|
||||
let plmnts = [PS (x/4, y/4) (pi/2) $ PutCrit spawnerCrit
|
||||
-- ,PS (0,0) 0 $ PutWindowBlock (x/2,0) (x/2,y-60)
|
||||
,wl
|
||||
,PS (x/2, y-10) 0 basicLS
|
||||
]
|
||||
|
||||
Reference in New Issue
Block a user