justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

More strictifiiiying

Browse Source
This commit is contained in:
justin
2021-07-30 01:25:11 +02:00
parent 2d8b27746c
commit 7b7fd302d8
37 changed files with 459 additions and 448 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room.hs
+123 -121
View File
@@ -33,6 +33,7 @@ import Dodge.Room.Door
import Dodge.Room.Airlock
import Dodge.Room.LongDoor
import Geometry
import Geometry.Data
import Picture
import Tile
@@ -41,6 +42,7 @@ import Control.Monad.State
import Control.Monad.Loops
import System.Random
import Data.Tree
import Data.Bifunctor
--import qualified Data.Map as M
--import qualified Data.IntMap.Strict as IM
@@ -49,12 +51,12 @@ roomC x y = defaultRoom
{ _rmPolys = [rectNSWE y 0 0 x]
, _rmLinks = lnks
, _rmPath = []
, _rmPS = [windowLine (x/2,0) (x/2,y-60)
, _rmPS = [windowLine (V2 (x/2) (0)) (V2 (x/2) (y-60))
]
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
}
where
lnks =
lnks = map (first toV2)
[( (x-20, 0),pi)
,( ( 20, 0),pi)
,( ( 0, 20),pi/2)
@@ -63,17 +65,17 @@ roomC x y = defaultRoom
roomPadCut :: [Point2] -> Point2 -> Room
roomPadCut ps p = defaultRoom
{ _rmPolys = [ps]
, _rmLinks = [(p,0),((0,0),pi)]
, _rmPath = [((0,0),p)]
, _rmLinks = [(p,0),((V2 0 0),pi)]
, _rmPath = [((V2 0 0),p)]
, _rmPS = []
, _rmBound = []
}
roomPillars :: Room
roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2
where
plmnts = sPS (120,120) 0 putLamp
: sPS (12,12) 0 putLamp
: sPS (228,228) 0 putLamp
plmnts = sPS (V2 120 120) 0 putLamp
: sPS (V2 12 12) 0 putLamp
: sPS (V2 228 228) 0 putLamp
: g 180 150 90 60
f a x b y = putBlockRect a x b y
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
@@ -88,15 +90,15 @@ glassSwitchBack = do
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)
, sPS (wth/2,hgt/2) 0 putLamp
[windowLine (V2 (wth-60 ) ( hf)) (V2 (wllen) (hf) )
,windowLine (V2 (wth-wllen) (2*hf)) (V2 (60 ) (2*hf))
,windowLine (V2 (wth-60 ) (3*hf)) (V2 (wllen) (3*hf))
,windowLine (V2 (wth-wllen) (4*hf)) (V2 (60 ) (4*hf))
,blockLine (V2 ( 0) (1*hf)) (V2 (wllen) (1*hf))
,blockLine (V2 (wth-wllen) (2*hf)) (V2 ( wth) (2*hf))
,blockLine (V2 ( 0) (3*hf)) (V2 (wllen) (3*hf))
,blockLine (V2 (wth-wllen) (4*hf)) (V2 ( wth) (4*hf))
, sPS (V2 (wth/2) (hgt/2)) 0 putLamp
]
return $ set rmPS plmnts $ roomRect wth hgt 2 6
@@ -112,14 +114,14 @@ glassLesson = do
botRoom = set rmPS botplmnts $ roomRect 200 200 1 1
topRoom = set rmPS topplmnts $ roomRect 200 200 1 1
botplmnts =
[sPS (0,0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
,sPS (50,100) 0 $ PutCrit miniGunCrit
,sPS (50,50) 0 putLamp
[sPS (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
,sPS (V2 50 100) 0 $ PutCrit miniGunCrit
,sPS (V2 50 50) 0 putLamp
]
topplmnts =
[windowLine (100,200) (100,0)
,sPS (50,100) 0 $ PutCrit miniGunCrit
,sPS (50,50) 0 putLamp
[windowLine (V2 100 200) (V2 100 0)
,sPS (V2 50 100) 0 $ PutCrit miniGunCrit
,sPS (V2 50 50) 0 putLamp
]
miniRoom1 :: RandomGen g => State g Room
@@ -133,45 +135,45 @@ miniRoom1 = do
,50+4*hf,30+5*hf
]
crx <- state $ randomR (wllen,wth-(wllen+40))
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)
,sPS (crx,cry) 0 $ PutCrit miniGunCrit
,sPS (wth-20,hgt/2+40) 0 randC1
,sPS (wth/2,hgt/2) 0 putLamp
,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)
let plmnts = [windowLine (V2 (wth-60) ( 40+hf)) (V2 (wllen) (40+hf))
,windowLine (V2 (wth-wllen) (40+2*hf)) (V2 (60) (40+2*hf))
,windowLine (V2 (wth-60) ( 40+3*hf)) (V2 (wllen) (40+3*hf))
,windowLine (V2 (wth-wllen) (40+4*hf)) (V2 (60) (40+4*hf))
,sPS (V2 crx cry) 0 $ PutCrit miniGunCrit
,sPS (V2 (wth-20) (hgt/2+40)) 0 randC1
,sPS (V2 (wth/2) (hgt/2)) 0 putLamp
,blockLine (V2 ( 0) ( 40+1*hf)) (V2 (wllen) (40+1*hf))
,blockLine (V2 (wth-wllen) ( 40+2*hf)) (V2 ( wth) (40+2*hf))
,blockLine (V2 ( 0) ( 40+3*hf)) (V2 (wllen) (40+3*hf))
,blockLine (V2 (wth-wllen) ( 40+4*hf)) (V2 ( wth) (40+4*hf))
]
return $ set rmPS plmnts $ shiftRoomBy ((0,40),0) $ roomRect wth hgt 2 4
return $ set rmPS plmnts $ shiftRoomBy ((V2 0 40),0) $ roomRect wth hgt 2 4
miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
miniTree2 = miniRoom1
>>= randomiseOutLinks
>>= changeLinkTo (\p -> (snd . fst) p < 70)
>>= changeLinkTo (\p -> (sndV2 . fst) p < 70)
<&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)
miniRoom3 :: RandomGen g => State g (Tree (Either Room Room))
miniRoom3 = do
w <- state $ randomR (300,400)
h <- state $ randomR (300,400)
let cp = (0,h/2+40)
let b = PutBlock [5,20,20] (greyN 0.5) [(-10,-60)
let cp = (V2 (0) (h/2+40))
let b = PutBlock [5,20,20] (greyN 0.5) $ map toV2 [(-10,-60)
,( 10,-60)
,( 10,-80)
,(-10,-80)
]
let plmnts = [sPS cp 0 $ PutCrit miniGunCrit
,sPS cp 0 $ windowLineType (0,-40) (0,-80)
,sPS cp (1*pi/4) $ windowLineType (0,-40) (0,-80)
,sPS cp (2*pi/4) $ windowLineType (0,-40) (0,-80)
,sPS cp (3*pi/4) $ windowLineType (0,-40) (0,-80)
,sPS cp (4*pi/4) $ windowLineType (0,-40) (0,-80)
,sPS cp (5*pi/4) $ windowLineType (0,-40) (0,-80)
,sPS cp (6*pi/4) $ windowLineType (0,-40) (0,-80)
,sPS cp (7*pi/4) $ windowLineType (0,-40) (0,-80)
,sPS cp 0 $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (1*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (2*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (3*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (4*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (5*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (6*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (7*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
,sPS cp (pi/8) b
,sPS cp (pi/8+1*pi/4) b
,sPS cp (pi/8+2*pi/4) b
@@ -180,7 +182,7 @@ miniRoom3 = do
,sPS cp (pi/8+5*pi/4) b
,sPS cp (pi/8+6*pi/4) b
,sPS cp (pi/8+7*pi/4) b
,sPS (w/2,h/2) 0 putLamp
,sPS (V2 (w/2) (h/2)) 0 putLamp
]
fmap connectRoom $ randomiseOutLinks $ set rmPS plmnts $ roomRectAutoLinks w h
@@ -203,14 +205,14 @@ roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treeFromPost
g (Node y ys) = Node y $ map g ys
roomCenterPillar :: RandomGen g => State g Room
roomCenterPillar = changeLinkTo ((\p -> dist p (120,0) < 10) . fst)
roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst)
$ set rmPS plmnts $ roomRect 240 240 2 2
where
plmnts =
[ blockLine (115,115) (115,125)
, blockLine (125,115) (125,125)
, sPS (40,120) 0 putLamp
, sPS (200,120) 0 putLamp
[ blockLine (V2 115 115) (V2 115 125)
, blockLine (V2 125 115) (V2 125 125)
, sPS (V2 40 120) 0 putLamp
, sPS (V2 200 120) 0 putLamp
]
roomOctogon :: Room
@@ -219,12 +221,12 @@ roomOctogon = defaultRoom
, _rmLinks = lnks
, _rmPath = allPairs $ map fst lnks
, _rmPS = []
, _rmBound = [[(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ]
, _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ]
, _rmFloor = [oTile poly 7]
}
where
poly = [(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)]
lnks =
poly = map toV2 [(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)]
lnks = map (first toV2)
[((0,140),0)
,((35,125),negate $ pi/4)
,((-35,125),pi/4)
@@ -259,26 +261,26 @@ weaponEmptyRoom = do
w <- state $ randomR (220,300)
h <- state $ randomR (220,300)
let plmnts =
[sPS (w/2,h-40) 0 $ RandPS randFirstWeapon
,sPS (20,20) (pi/2) randC1
,sPS (w-20,20) (pi/2) randC1
,sPS (w/2,h/2) 0 putLamp
[sPS (V2 (w/2) (h-40)) 0 $ RandPS randFirstWeapon
,sPS (V2 20 20) (pi/2) randC1
,sPS (V2 (w-20) (20)) (pi/2) randC1
,sPS (V2 (w/2) (h/2)) 0 putLamp
]
(fmap connectRoom . randomiseOutLinks) =<<
changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst) (set rmPS plmnts $ roomRect w h 2 2)
changeLinkTo ((\p -> dist p (V2 (w/2) (0)) < 10) . fst) (set rmPS plmnts $ roomRect w h 2 2)
weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room))
weaponUnderCrits = do
let plmnts =
[sPS (20,0) 0 $ RandPS randFirstWeapon
,sPS (20,0) (negate $ pi/2) randC1
,sPS (20,20) (negate $ pi/2) randC1
[sPS (V2 20 0) 0 $ RandPS randFirstWeapon
,sPS (V2 20 0) (negate $ pi/2) randC1
,sPS (V2 20 20) (negate $ pi/2) randC1
]
let continuationRoom = treeFromTrunk
[Left corridorN,Left corridorN]
(connectRoom (set rmPS plmnts corridorN))
rcp' <- roomCenterPillar
let rcp = over rmPS ( sPS (120,80) 0 putLamp : ) rcp'
let rcp = over rmPS ( sPS (V2 120 80) 0 putLamp : ) rcp'
deadEndRoom' <- takeOne [roomPillars,rcp]
junctionRoom <- takeOne [Left tEast,Left tWest]
return $ treeFromTrunk [Left corridorN,Left corridorN]
@@ -289,10 +291,10 @@ weaponUnderCrits = do
weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room))
weaponBehindPillar = do
cpos <- takeOne $ [(x,y) | x <- [20,220], y <- [20,220]] ++ [(120,160),(120,200)]
let d p = argV $ (120,80) -.- p
cpos <- takeOne $ [(V2 x y) | x <- [20,220], y <- [20,220]] ++ [(V2 120 160),(V2 120 200)]
let d p = argV $ (V2 120 80) -.- p
let plmnts1 =
[sPS (120,160) 0 $ RandPS randFirstWeapon
[sPS (V2 120 160) 0 $ RandPS randFirstWeapon
,sPS cpos (d cpos) randC1
]
rcp <- roomCenterPillar
@@ -300,15 +302,15 @@ weaponBehindPillar = do
[Left door
,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp
]
(connectRoom $ set rmPS [sPS (20,60) (negate $ pi/2) randC1] corridorN)
(connectRoom $ set rmPS [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room))
weaponBetweenPillars = do
wpPos <- takeOne [(x,y) | x <- [20,120,220], y <- [20,120,220]]
(ps,_) <- takeNMore 2 ([], [(x,y) | x <- [20,220], y <- [20,120,220]])
wpPos <- takeOne [(V2 x y) | x <- [20,120,220], y <- [20,120,220]]
(ps,_) <- takeNMore 2 ([], [(V2 x y) | x <- [20,220], y <- [20,120,220]])
let crPos1 = ps !! 0
crPos2 = ps !! 1
d p = argV $ (120,120) -.- p
d p = argV $ (V2 120 120) -.- p
plmnts =
[sPS wpPos 0 $ RandPS randFirstWeapon
,sPS crPos1 (d crPos1) randC1
@@ -325,8 +327,8 @@ weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
weaponLongCorridor = do
root <- takeOne [tEast, tWest]
connectingRoom <- takeOne
[tEast & rmPS .~ [sPS (-40,60) 0 putLamp]
,tWest & rmPS .~ [sPS ( 40,60) 0 putLamp]
[tEast & rmPS .~ [sPS (V2 (-40) (60)) 0 putLamp]
,tWest & rmPS .~ [sPS (V2 40 60) 0 putLamp]
]
i1 <- state $ randomR (2,5)
i2 <- state $ randomR (2,5)
@@ -334,11 +336,11 @@ weaponLongCorridor = do
let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor)
return $ Node (Left root) [branch1,branch2]
where
putCrs = over rmPS (++ [sPS (10,40) (-pi/2) randC1 ,sPS (-10,40) (-pi/2) randC1 ])
putWp = set rmPS [sPS (20,40) 0 $ RandPS randFirstWeapon ,sPS (20,60) 0 putLamp ]
putCrs = over rmPS (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) (40)) (-pi/2) randC1 ])
putWp = set rmPS [sPS (V2 20 40) 0 $ RandPS randFirstWeapon ,sPS (V2 20 60) 0 putLamp ]
critInDeadEnd :: Room
critInDeadEnd = set rmPS [sPS (0,0) 0 randC1] deadEndRoom
critInDeadEnd = set rmPS [sPS (V2 0 0) 0 randC1] deadEndRoom
deadEndRoom :: Room
deadEndRoom = defaultRoom
@@ -346,11 +348,11 @@ deadEndRoom = defaultRoom
]
, _rmLinks = lnks
, _rmPath = []
, _rmPS = [sPS (0,-10) 0 putLamp]
, _rmPS = [sPS (V2 (0) (-10)) 0 putLamp]
, _rmBound = [rectNSWE 20 (-20) (-30) 30]
}
where
lnks = [((0,30) ,0) ]
lnks = [((V2 0 30) ,0) ]
{- A random Either tree with a weapon and melee monster challenge. -}
weaponRoom :: RandomGen g => State g (Tree (Either Room Room))
weaponRoom = join $ takeOne
@@ -365,8 +367,8 @@ roomCCrits :: RandomGen g => State g (Tree (Either Room Room))
roomCCrits = do
ps <- replicateM 20 $ randInCirc 9
let plmnts = map (\p -> sPS p 0 randC1)
$ zipWith (+.+) [(x,y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps
lamps = [sPS (50,100) 0 putLamp , sPS (175,100) 0 putLamp]
$ zipWith (+.+) [(V2 x y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps
lamps = [sPS (V2 50 100) 0 putLamp , sPS (V2 175 100) 0 putLamp]
return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200
@@ -374,40 +376,40 @@ longRoom :: RandomGen g => State g Room
longRoom = do
h <- state $ randomR (1500,1500)
let w = 75
let cond x = (snd . fst) x < h - 40
let ws = map (\ps -> sPS (0,0) 0 $ PutWall ps defaultCrystalWall)
let cond x = (sndV2 . fst) x < h - 40
let ws = map (\ps -> sPS (V2 0 0) 0 $ PutWall ps defaultCrystalWall)
[rectNSWE (h-35) (h-135) (-10) 10
,rectNSWE (h-35) (h-135) 15 35
,rectNSWE (h-35) (h-135) 40 60
,rectNSWE (h-35) (h-135) 65 85
]
let wsDefense = map (\ps -> sPS (0,0) 0 $ PutWall ps defaultCrystalWall)
let wsDefense = map (\ps -> sPS (V2 0 0) 0 $ PutWall ps defaultCrystalWall)
[rectNSWE 95 70 0 25
,rectNSWE 95 70 50 75
]
brls <- fmap (map (\p -> sPS (p +.+ (10,200)) 0 $ PutCrit explosiveBarrel) )
brls <- fmap (map (\p -> sPS (p +.+ (V2 10 200)) 0 $ PutCrit explosiveBarrel) )
$ replicateM 5 $ randInRect (w-20) 900
let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
changeLinkTo cond $ rm & rmPS .~ ws ++ brls ++ wsDefense ++
[sPS ( 12.5,h-25) 0 $ PutCrit longCrit
,sPS ( 37.5,h-25) 0 $ PutCrit longCrit
,sPS ( 62.5,h-25) 0 $ PutCrit longCrit
,sPS ( 25, 20) 0 putLamp
,sPS ( 25,h-10) 0 putLamp
[sPS (V2 12.5 (h-25)) 0 $ PutCrit longCrit
,sPS (V2 37.5 (h-25)) 0 $ PutCrit longCrit
,sPS (V2 62.5 (h-25)) 0 $ PutCrit longCrit
,sPS (V2 25 ( 20)) 0 putLamp
,sPS (V2 25 (h-10)) 0 putLamp
]
shooterRoom :: RandomGen g => State g Room
shooterRoom = do
h <- state $ randomR (200,300)
let cond x = (snd . fst) x < h - 40
let cond x = (sndV2 . fst) x < h - 40
changeLinkTo cond $ roomRect 100 h 1 1 & rmPS .~
[blockLine (50,50) (50,h)
,sPS ( 25,h-25) 0 $ PutCrit $ addArmour autoCrit
,sPS ( 75,h-30) 0 $ PutCrit explosiveBarrel
,sPS ( 75,h-60) 0 $ PutCrit explosiveBarrel
,sPS ( 85,h-10) 0 $ PutCrit explosiveBarrel
,sPS ( 85,h-45) 0 $ PutCrit explosiveBarrel
,sPS ( 75,h-80) 0 putLamp
[blockLine (V2 50 50) (V2 50 h)
,sPS (V2 25 (h-25)) 0 $ PutCrit $ addArmour autoCrit
,sPS (V2 75 (h-30)) 0 $ PutCrit explosiveBarrel
,sPS (V2 75 (h-60)) 0 $ PutCrit explosiveBarrel
,sPS (V2 85 (h-10)) 0 $ PutCrit explosiveBarrel
,sPS (V2 85 (h-45)) 0 $ PutCrit explosiveBarrel
,sPS (V2 75 (h-80)) 0 putLamp
]
shootersRoom1 :: RandomGen g => State g Room
@@ -426,7 +428,7 @@ shootersRoom1 = do
let blv x y = putBlockV (x+25) (x-25) (y+10) y
let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
++ [sPS p (-pi/2) $ PutCrit autoCrit
,sPS (w/2,200) 0 putLamp
,sPS (V2 (w/2) (200)) 0 putLamp
]
return $ set rmPS plmnts $ roomRectAutoLinks w 600
@@ -444,16 +446,16 @@ shootersRoom = do
let bln x y = putBlockN (x+25) (x-25) (y+10) y
let blv x y = putBlockV (x+25) (x-25) (y+10) y
let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
++ [sPS (x1,y1-10) (-pi/2) $ PutCrit autoCrit
,sPS (x2,y2-10) (-pi/2) $ PutCrit autoCrit
,sPS (x3,y3-10) (-pi/2) $ PutCrit autoCrit
,sPS (w/2,200) 0 putLamp
++ [sPS (V2 (x1) (y1-10)) (-pi/2) $ PutCrit autoCrit
,sPS (V2 (x2) (y2-10)) (-pi/2) $ PutCrit autoCrit
,sPS (V2 (x3) (y3-10)) (-pi/2) $ PutCrit autoCrit
,sPS (V2 (w/2) (200)) 0 putLamp
]
return $ set rmPS plmnts $ roomRectAutoLinks w 600
pistolerRoom :: RandomGen g => State g Room
pistolerRoom = do
let f2 x y = singleBlock (x,y)
let f2 x y = singleBlock (V2 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)
@@ -469,20 +471,20 @@ pistolerRoom = do
xs = take i [20+0.5*(w-40)/(j-1),20+1.5*(w-40)/(j-1)..]
ys = take i [20+0.5*(h-40)/(j-1),20+1.5*(h-40)/(j-1)..]
gap = 0.5 * h / j
ps <- takeN 3 $ zip (map (+gap) xs) ys
ps <- takeN 3 $ zipWith V2 (map (+gap) xs) ys
aa <- state $ randomR (0,2*pi)
ab <- state $ randomR (0,2*pi)
ac <- state $ randomR (0,2*pi)
let plmnts = [sPS (ps !! 0) aa $ PutCrit pistolCrit
,sPS (ps !! 1) ab $ PutCrit pistolCrit
,sPS (ps !! 2) ac $ PutCrit pistolCrit
,sPS (w/2,h-50) 0 putLamp
,sPS (w/2,50) 0 putLamp
,sPS (w-5,h-5) 0 putLamp
,sPS (5,h-5) 0 putLamp
,sPS (w-5,5) 0 putLamp
,sPS (5,5) 0 putLamp
,sPS (w/2,h/2) 0 putLamp
,sPS (V2 (w/2) (h-50)) 0 putLamp
,sPS (V2 (w/2) (50) ) 0 putLamp
,sPS (V2 (w-5) (h-5) ) 0 putLamp
,sPS (V2 ( 5) (h-5) ) 0 putLamp
,sPS (V2 (w-5) (5) ) 0 putLamp
,sPS (V2 ( 5) (5) ) 0 putLamp
,sPS (V2 (w/2) (h/2) ) 0 putLamp
]
++
concat [f x y | x<-xs,y<-ys]
@@ -491,16 +493,16 @@ pistolerRoom = do
shootingRange :: RandomGen g => State g (Tree (Either Room Room))
shootingRange = do
rm1 <- shootersRoom1 >>= changeLinkTo (\((_,y),_) -> y < 40)
>>= filterLinks (\((_,y),r) -> y > 200 && r /= 0)
rm2 <- shootersRoom >>= changeLinkTo (\((x,y),_) -> y < 10 && x > 20 && x < 180)
>>= filterLinks (\((_,y),r) -> y > 200 && r /= 0)
rm3 <- shootersRoom >>= changeLinkTo (\((x,y),_) -> y < 10 && x > 20 && x < 180)
rm1 <- shootersRoom1 >>= changeLinkTo (\((V2 _ y),_) -> y < 40)
>>= filterLinks (\((V2 _ y),r) -> y > 200 && r /= 0)
rm2 <- shootersRoom >>= changeLinkTo (\((V2 x y),_) -> y < 10 && x > 20 && x < 180)
>>= filterLinks (\((V2 _ y),r) -> y > 200 && r /= 0)
rm3 <- shootersRoom >>= changeLinkTo (\((V2 x y),_) -> y < 10 && x > 20 && x < 180)
>>= filterLinks (\(_,r) -> r == 0)
return $ treeFromPost [Left rm1
,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (0,20)
,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (V2 0 20)
,Left rm2
,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (0,20)
,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (V2 0 20)
]
(Right rm3)
@@ -508,13 +510,13 @@ spawnerRoom :: RandomGen g => State g (Tree (Either Room Room))
spawnerRoom = do
x <- state $ randomR (250,300)
y <- state $ randomR (300,400)
wl <- takeOne [sPS (0,0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10))
wl <- takeOne [sPS (V2 0 0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10))
defaultCrystalWall
,windowLine (x/2,0) (x/2,y-60)
,windowLine (V2 (x/2) (0)) (V2 (x/2) (y-60))
]
let plmnts = [sPS (x/4, y/4) (pi/2) $ PutCrit spawnerCrit
let plmnts = [sPS (V2 (x/4) ( y/4)) (pi/2) $ PutCrit spawnerCrit
,wl
,sPS (x/2, y-10) 0 putLamp
,sPS (V2 (x/2) ( y-10)) 0 putLamp
]
let f ((lx,_),_) = lx < x/2-5
roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (set rmPS plmnts $ roomRect x y 2 2)