diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index e383132bd..d81f76de2 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 86197ac16..f71ee3439 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -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 diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 3ac8c5b61..c207a3241 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -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]) diff --git a/src/Dodge/LevelGen/Block.hs b/src/Dodge/LevelGen/Block.hs index 8b5125ddf..ea5d21054 100644 --- a/src/Dodge/LevelGen/Block.hs +++ b/src/Dodge/LevelGen/Block.hs @@ -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]) diff --git a/src/Dodge/LevelGen/LineBlock.hs b/src/Dodge/LevelGen/LineBlock.hs new file mode 100644 index 000000000..6daf1242e --- /dev/null +++ b/src/Dodge/LevelGen/LineBlock.hs @@ -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 + diff --git a/src/Dodge/LevelGen/WindowBlock.hs b/src/Dodge/LevelGen/WindowBlock.hs deleted file mode 100644 index 7be3d6033..000000000 --- a/src/Dodge/LevelGen/WindowBlock.hs +++ /dev/null @@ -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 - diff --git a/src/Dodge/Room/Placement.hs b/src/Dodge/Room/Placement.hs new file mode 100644 index 000000000..0bcae0269 --- /dev/null +++ b/src/Dodge/Room/Placement.hs @@ -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] + } diff --git a/src/Dodge/Rooms.hs b/src/Dodge/Rooms.hs index 2aeefe86a..17eaab025 100644 --- a/src/Dodge/Rooms.hs +++ b/src/Dodge/Rooms.hs @@ -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 ]