diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 2b81494ae..efb761059 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -279,7 +279,7 @@ startInventory = IM.fromList (zip [0..20] ,lasGun ,autoGun --,poisonSprayer - --,launcher + ,launcher --,lasGun --,grenade --,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 0f0645d21..58f131672 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -30,6 +30,7 @@ import Dodge.SoundLogic import Dodge.RandomHelp import Dodge.LightSources import Dodge.LevelGen.Data +import Dodge.LevelGen.SwarmPlacement import Dodge.Item.Weapon import Data.Tree @@ -50,7 +51,7 @@ roomTreex = do [[StartRoom] ,[Corridor] ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 - & rmPS %~ (PS (0,200) 0 (PutCrit spreadGunCrit) :) + & rmPS %~ ([swarmPS 0 (x,y) 0 smallChaseCrit | x <- [-20,-19.5.. 20] , y <- [200,200.5..202] ]++) ] ,[Corridor] ,[Corridor] diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 3f290528b..8f323f384 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -37,56 +37,66 @@ import qualified Data.Set as S import qualified Data.Map as M -placeSpots :: [PlacementSpot] -> World -> World -placeSpots pss w = foldr placeSpot w pss +placeSpots :: [Placement] -> World -> World +placeSpots pss w = foldr placeSpot w' $ map _placementSpot singlePlacements + where + (singlePlacements, groupedPlacements) = partition isSPS pss + isSPS (SinglePlacement {}) = True + isSPS _ = False + gplmnts = groupBy ((==) `on` _groupPlacementID) $ sortOn _groupPlacementID groupedPlacements + w' = foldr updateGroup w gplmnts + +{- | OK, this is perhaps slightly impenetrable. + - The idea is that for a list of collected group placements, we first update + - the world for each placement and update the placements into PSTypes. + - This is the mapAccumR step. + - After this, for each placement we apply the group placement function to + - the psType using a zipWith, and taking all the pstypes as a paramenter, + - then successively update the world using a foldr. -} +updateGroup :: [Placement] -> World -> World +updateGroup ps w = + let (w', psTypes) = mapAccumR updateSpot w $ map _placementSpot ps + fs = zipWith (\gp pst -> _groupPlacementFunc gp psTypes pst) ps psTypes + in foldr ($) w' fs + +updateSpot :: World -> PlacementSpot -> (World, PSType) +updateSpot w ps = case _psType ps of + PutButton bt -> undefined + PutCrit cr -> placeUpdateCr cr p rot w + where + p = _psPos ps + rot = _psRot ps placeSpot :: PlacementSpot -> World -> World -placeSpot ps w = case ps of - PS {_psPos = p, _psRot = rot, _psType = PutButton bt} - -> placeBt bt p rot w - PS {_psPos = p, _psRot = rot, _psType = PutFlIt itm} - -> placeFlIt itm p rot w - PS {_psPos = p, _psRot = rot, _psType = PutCrit cr} - -> placeCr cr p rot w - PS {_psPos = p, _psRot = rot, _psType = PutLS ls dec} - -> placeLS ls dec p rot w - PS {_psPos = p, _psRot = rot, _psType = PutPressPlate pp} - -> placePressPlate pp p rot w - PS {_psType = RandPS rgen} - -> placeSpot (set psType evaluatedType ps) (set randGen g w) +placeSpot ps w = case _psType ps of + PutButton bt -> placeBt bt p rot w + PutFlIt itm -> placeFlIt itm p rot w + PutCrit cr -> placeCr cr p rot w + PutLS ls dec -> placeLS ls dec p rot w + PutPressPlate pp -> placePressPlate pp p rot w + RandPS rgen -> placeSpot (set psType evaluatedType ps) (set randGen g w) where - (evaluatedType, g) = runState rgen (_randGen w) - - PS {_psPos = p, _psRot = rot, _psType = PutDoor col f pss} - -> putDoor col f (map (mapBoth $ shiftPointBy (p,rot)) pss) w + (evaluatedType, g) = runState rgen (_randGen w) + PutDoor col f pss -> putDoor col f (map (mapBoth $ shiftPointBy (p,rot)) pss) w where mapBoth fn (x,y) = (fn x, fn y) - - PS {_psPos = p, _psRot = rot, _psType = PutDoubleDoor col f a b} - -> putDoubleDoor col f (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w - - PS {_psPos = p, _psRot = rot, _psType = PutAutoDoor a b} - -> 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 - - PS {_psPos = p, _psRot = rot, _psType = PutBtDoor c bp f a b} - -> addButtonDoor c (shiftPointBy (p,rot) bp) (f + rot) + PutDoubleDoor col f a b -> putDoubleDoor col f (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w + PutAutoDoor a b -> addAutoDoor (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w + PutBlock (hp:hps) col ps -> putBlock (map (shiftPointBy (p,rot)) ps) hp col False hps w + PutBtDoor c bp f a b -> addButtonDoor c (shiftPointBy (p,rot) bp) (f + rot) (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w - PS {_psPos = p, _psRot = rot, _psType = PutSwitchDoor c bp f a b} - -> addSwitchDoor c (shiftPointBy (p,rot) bp) (f + rot) + PutSwitchDoor c bp f a b -> addSwitchDoor c (shiftPointBy (p,rot) bp) (f + rot) (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 a b -> putLineBlock wl width depth (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w - - PS {_psPos = p, _psRot = rot, _psType = PutWall { _pwPoly = ps, _pwWall = wl }} - -> rmCrossPaths $ over walls (addWalls (q:qs) wl) w - where (q:qs) = map (shiftPointBy (p,rot)) ps - rmCrossPaths w = foldr (uncurry removePathsCrossing) w $ zip (q:qs) (qs++[q]) - + PutWall { _pwPoly = ps, _pwWall = wl } -> rmCrossPaths $ over walls (addWalls (q:qs) wl) w + where + (q:qs) = map (shiftPointBy (p,rot)) ps + rmCrossPaths w = foldr (uncurry removePathsCrossing) w $ zip (q:qs) (qs++[q]) _ -> w + where + p = _psPos ps + rot = _psRot ps -- TODO: remove this typeclass class Shiftable a where @@ -109,7 +119,6 @@ instance Shiftable PlacementSpot where translateS p' (PS p r x) = PS (p +.+ p') r x rotateS r' (PS p r x) = PS (rotateV r' p) (r + r') x - shiftPointBy (pos,rot) p = pos +.+ rotateV rot p addWalls :: [Point2] -> Wall -> IM.IntMap Wall -> IM.IntMap Wall @@ -117,6 +126,7 @@ addWalls qs wl wls = foldr (addPane wl) wls pairs where (p:ps) = orderPolygon qs pairs = zip (ps ++ [p]) (p:ps) + addPane :: Wall -> (Point2,Point2) -> IM.IntMap Wall -> IM.IntMap Wall addPane wl (p0,p1) wls = IM.insert (newKey wls) (wl { _wlLine = (p0,p1) @@ -124,15 +134,11 @@ addPane wl (p0,p1) wls = IM.insert (newKey wls) (wl }) wls - placeBt bt p rot w = over buttons addBT w where addBT bts = IM.insert (newKey bts) (bt {_btPos = p, _btRot = rot, _btID = newKey bts}) bts - -{- -Creates a floor item at a given point. -Assigns an id correctly. --} +{- Creates a floor item at a given point. +Assigns an id correctly. -} placeFlIt :: Item -> Point2 -- ^ Position @@ -150,13 +156,21 @@ placeFlIt itm p rot = floorItems %~ ) fis placePressPlate pp p rot w = over pressPlates addPP w - where addPP pps = IM.insert (newKey pps) (pp {_ppPos = p,_ppRot = rot}) pps + where + addPP pps = IM.insert (newKey pps) (pp {_ppPos = p,_ppRot = rot}) pps + +placeUpdateCr :: Creature -> Point2 -> Float -> World -> (World, PSType) +placeUpdateCr scr p rot w = (w & creatures %~ IM.insert cid cr, PutCrit cr) + where + cid = newKey (_creatures w) + cr = scr {_crPos = p,_crOldPos = p,_crDir = rot,_crID = cid} placeCr :: Creature -> Point2 -> Float -> World -> World placeCr crF p rot w = over creatures addCr w - where addCr crs = IM.insert (newKey crs) - (crF {_crPos = p,_crOldPos = p,_crDir = rot,_crID = newKey crs}) - crs + where + addCr crs = IM.insert (newKey crs) + (crF {_crPos = p,_crOldPos = p,_crDir = rot,_crID = newKey crs}) + crs placeLS :: LightSource -> Picture -> Point2 -> Float -> World -> World placeLS ls dec p rot w = over lightSources addLS diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 34a2ab16c..d678124cf 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -9,7 +9,7 @@ import Control.Lens import Control.Monad.State import System.Random -data PSType = PutCrit Creature +data PSType = PutCrit {_unPutCrit :: Creature} | PutLS LightSource Picture | PutButton Button | PutFlIt Item @@ -34,10 +34,12 @@ data Placement = SinglePlacement {_placementSpot :: PlacementSpot } | GroupedPlacement {_groupPlacementID :: Int - ,_groupPlacementFunc :: [PlacementSpot] -> PlacementSpot -> PlacementSpot + ,_groupPlacementFunc :: [PSType] -> PSType -> World -> World ,_placementSpot :: PlacementSpot } +sPS p a = SinglePlacement . PS p a + makeLenses ''PSType makeLenses ''PlacementSpot makeLenses ''Placement diff --git a/src/Dodge/LevelGen/SwarmPlacement.hs b/src/Dodge/LevelGen/SwarmPlacement.hs new file mode 100644 index 000000000..faf9cfb37 --- /dev/null +++ b/src/Dodge/LevelGen/SwarmPlacement.hs @@ -0,0 +1,25 @@ +module Dodge.LevelGen.SwarmPlacement + ( swarmPS + ) + where +import Dodge.Data +import Dodge.LevelGen.Data +import Dodge.Creature.State.Data + +import qualified Data.Set as S +import Control.Lens + +swarmPS :: Int -> Point2 -> Float -> Creature -> Placement +swarmPS i p a cr = GroupedPlacement + { _groupPlacementID = i + , _groupPlacementFunc = setSwarm + , _placementSpot = PS p a $ PutCrit cr + } + +setSwarm :: [PSType] -> PSType -> World -> World +setSwarm psts (PutCrit cr) w + = w & creatures . ix cid . crGroup .~ theSwarm + where + cid = _crID cr + theSwarm = Swarm swarmSet + swarmSet = S.fromList $ map (_crID . _unPutCrit) psts diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 9ba90753b..12d591c38 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -77,9 +77,9 @@ roomPadCut ps p = Room roomPillars :: Room roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2 where - plmnts = PS (120,120) 0 putLamp - : PS (12,12) 0 putLamp - : PS (228,228) 0 putLamp + plmnts = sPS (120,120) 0 putLamp + : sPS (12,12) 0 putLamp + : sPS (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 @@ -103,7 +103,7 @@ glassSwitchBack = do ,blockLine (wth-wllen, 2*hf) ( wth,2*hf) ,blockLine ( 0, 3*hf) (wllen,3*hf) ,blockLine (wth-wllen, 4*hf) ( wth,4*hf) - , PS (wth/2,hgt/2) 0 $ putLamp + , sPS (wth/2,hgt/2) 0 $ putLamp ] return $ set rmPS plmnts $ roomRect wth hgt 2 6 @@ -119,14 +119,14 @@ glassLesson = do $ roomRect 200 200 1 1 topRoom = set rmPS topplmnts $ roomRect 200 200 1 1 - botplmnts = [PS (0,0) 0 $ PutWall (rectNSWE (200) 0 (90) (110)) + botplmnts = [sPS (0,0) 0 $ PutWall (rectNSWE (200) 0 (90) (110)) $ defaultCrystalWall - ,PS (50,100) 0 $ PutCrit miniGunCrit - ,PS (50,50) 0 putLamp + ,sPS (50,100) 0 $ PutCrit miniGunCrit + ,sPS (50,50) 0 putLamp ] topplmnts = [windowLine (100,200) (100,0) - ,PS (50,100) 0 $ PutCrit miniGunCrit - ,PS (50,50) 0 putLamp + ,sPS (50,100) 0 $ PutCrit miniGunCrit + ,sPS (50,50) 0 putLamp ] miniRoom1 :: RandomGen g => State g Room @@ -144,9 +144,9 @@ miniRoom1 = do ,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 putLamp + ,sPS (crx,cry) 0 $ PutCrit miniGunCrit + ,sPS (wth-20,hgt/2+40) 0 $ randC + ,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) @@ -169,24 +169,24 @@ miniRoom3 = do ,( 10,-80) ,(-10,-80) ] - let plmnts = [PS cp 0 $ PutCrit miniGunCrit - ,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 - ,PS cp (pi/8+3*pi/4) b - ,PS cp (pi/8+4*pi/4) b - ,PS cp (pi/8+5*pi/4) b - ,PS cp (pi/8+6*pi/4) b - ,PS cp (pi/8+7*pi/4) b - ,PS (w/2,h/2) 0 putLamp + 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 (pi/8) b + ,sPS cp (pi/8+1*pi/4) b + ,sPS cp (pi/8+2*pi/4) b + ,sPS cp (pi/8+3*pi/4) b + ,sPS cp (pi/8+4*pi/4) b + ,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 ] fmap connectRoom $ randomiseOutLinks $ set rmPS plmnts $ roomRectAutoLinks w h @@ -215,8 +215,8 @@ roomCenterPillar = changeLinkTo ((\p -> dist p (120,0) < 10) . fst) plmnts = [ blockLine (115,115) (115,125) , blockLine (125,115) (125,125) - , PS (40,120) 0 putLamp - , PS (200,120) 0 putLamp + , sPS (40,120) 0 putLamp + , sPS (200,120) 0 putLamp ] roomOctogon :: Room @@ -264,10 +264,10 @@ weaponEmptyRoom :: RandomGen g => State g (Tree (Either Room Room)) weaponEmptyRoom = do w <- state $ randomR (220,300) h <- state $ randomR (220,300) - let plmnts = [PS (w/2,h-40) 0 $ RandPS randFirstWeapon - ,PS (20,20) (pi/2) $ randC1 - ,PS (w-20,20) (pi/2) $ randC1 - ,PS (w/2,h/2) 0 $ putLamp + 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 ] (fmap connectRoom . randomiseOutLinks) =<< (changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst) $ set rmPS plmnts $ roomRect w h 2 2) @@ -275,14 +275,14 @@ weaponEmptyRoom = do weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room)) weaponUnderCrits = do let plmnts = - [PS (20,0) 0 $ RandPS randFirstWeapon - ,PS (20,0) (0-pi/2) $ randC1 - ,PS (20,20) (0-pi/2) $ randC1 + [sPS (20,0) 0 $ RandPS randFirstWeapon + ,sPS (20,0) (0-pi/2) $ randC1 + ,sPS (20,20) (0-pi/2) $ randC1 ] let continuationRoom = treeFromTrunk [Left corridorN,Left corridorN] (connectRoom (set rmPS plmnts $ corridorN)) rcp' <- roomCenterPillar - let rcp = over rmPS ( PS (120,80) 0 putLamp : ) rcp' + let rcp = over rmPS ( sPS (120,80) 0 putLamp : ) rcp' deadEndRoom <- takeOne [roomPillars,rcp] junctionRoom <- takeOne [Left tEast,Left tWest] return $ treeFromTrunk [Left corridorN,Left corridorN] @@ -295,13 +295,13 @@ weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room)) weaponBehindPillar = do crPos <- takeOne $ [(x,y) | x <- [20,220], y <- [20,220]] ++ [(120,160),(120,200)] let d p = argV $ (120,80) -.- p - let plmnts1 = [PS (120,160) 0 $ RandPS randFirstWeapon - ,PS crPos (d crPos) $ randC1 + let plmnts1 = [sPS (120,160) 0 $ RandPS randFirstWeapon + ,sPS crPos (d crPos) $ randC1 ] rcp <- roomCenterPillar return $ treeFromTrunk [Left door ,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp] - (connectRoom $ set rmPS [PS (20,60) (0-pi/2) $ randC1] + (connectRoom $ set rmPS [sPS (20,60) (0-pi/2) $ randC1] $ corridorN) weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room)) @@ -312,9 +312,9 @@ weaponBetweenPillars = do crPos2 = ps !! 1 d p = argV $ (120,120) -.- p plmnts = - [PS wpPos 0 $ RandPS randFirstWeapon - ,PS crPos1 (d crPos1) $ randC1 - ,PS crPos2 (d crPos2) $ randC1 + [sPS wpPos 0 $ RandPS randFirstWeapon + ,sPS crPos1 (d crPos1) $ randC1 + ,sPS crPos2 (d crPos2) $ randC1 ] (fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars) where @@ -324,23 +324,23 @@ weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room)) weaponLongCorridor = do root <- takeOne $ [tEast, tWest] connectingRoom <- takeOne - [tEast & rmPS .~ [PS (-40,60) 0 $ putLamp] - ,tWest & rmPS .~ [PS ( 40,60) 0 $ putLamp] + [tEast & rmPS .~ [sPS (-40,60) 0 $ putLamp] + ,tWest & rmPS .~ [sPS ( 40,60) 0 $ putLamp] ] i1 <- state $ randomR (2,5) i2 <- state $ randomR (2,5) let branch1 = treeFromTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom) let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor) return $ Node (Left root) [branch1,branch2] - where putCrs = over rmPS (++ [PS (10,40) (-pi/2) $ randC - ,PS (-10,40) (-pi/2) $ randC + where putCrs = over rmPS (++ [sPS (10,40) (-pi/2) $ randC + ,sPS (-10,40) (-pi/2) $ randC ]) - putWp = set rmPS [PS (20,40) 0 $ RandPS randFirstWeapon - ,PS (20,60) 0 $ putLamp + putWp = set rmPS [sPS (20,40) 0 $ RandPS randFirstWeapon + ,sPS (20,60) 0 $ putLamp ] critInDeadEnd :: Room -critInDeadEnd = set rmPS [PS (0,0) 0 $ randC] deadEndRoom +critInDeadEnd = set rmPS [sPS (0,0) 0 $ randC] deadEndRoom deadEndRoom :: Room deadEndRoom = Room @@ -348,7 +348,7 @@ deadEndRoom = Room ] , _rmLinks = lnks , _rmPath = [] - , _rmPS = [PS (0,-10) 0 putLamp] + , _rmPS = [sPS (0,-10) 0 putLamp] , _rmBound = [rectNSWE 20 (-20) (-30) 30] } where @@ -366,9 +366,9 @@ weaponRoom = join $ takeOne roomCCrits :: RandomGen g => State g (Tree (Either Room Room)) roomCCrits = do ps <- sequence $ replicate 20 $ randInCirc 9 - let plmnts = map (\p -> PS p 0 $ randC) + let plmnts = map (\p -> sPS p 0 $ randC) $ zipWith (+.+) [(x,y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps - lamps = [PS (50,100) 0 putLamp , PS (175,100) 0 putLamp] + lamps = [sPS (50,100) 0 putLamp , sPS (175,100) 0 putLamp] return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200 @@ -377,25 +377,25 @@ longRoom = do h <- state $ randomR (1500,1500) let w = 75 let cond x = (snd . fst) x < h - 40 - let ws = map (\ps -> PS (0,0) 0 $ PutWall ps defaultCrystalWall) + let ws = map (\ps -> sPS (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 -> PS (0,0) 0 $ PutWall ps defaultCrystalWall) + let wsDefense = map (\ps -> sPS (0,0) 0 $ PutWall ps defaultCrystalWall) [rectNSWE (95) (70) 0 25 ,rectNSWE (95) (70) 50 75 ] - brls <- fmap (map (\p -> PS (p +.+ (10,200)) 0 $ PutCrit explosiveBarrel) ) + brls <- fmap (map (\p -> sPS (p +.+ (10,200)) 0 $ PutCrit explosiveBarrel) ) $ sequence $ replicate 5 $ randInRect (w-20) 900 let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++) changeLinkTo cond $ set rmPS (ws ++ brls ++ wsDefense ++ - [PS ( 12.5,h-25) 0 $ PutCrit longCrit - ,PS ( 37.5,h-25) 0 $ PutCrit longCrit - ,PS ( 62.5,h-25) 0 $ PutCrit longCrit - ,PS ( 25, 20) 0 $ putLamp - ,PS ( 25, h-10) 0 $ putLamp + [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 ] ) $ rm @@ -406,12 +406,12 @@ shooterRoom = do h <- state $ randomR (200,300) let cond x = (snd . fst) x < h - 40 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 - ,PS ( 85,h-45) 0 $ PutCrit explosiveBarrel - ,PS ( 75,h-80) 0 putLamp + ,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 ] ) $ roomRect 100 h 1 1 @@ -432,8 +432,8 @@ shootersRoom1 = 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 - ++ [PS p (-pi/2) $ PutCrit autoCrit - ,PS (w/2,200) 0 putLamp + ++ [sPS p (-pi/2) $ PutCrit autoCrit + ,sPS (w/2,200) 0 putLamp ] return $ set rmPS plmnts $ roomRectAutoLinks w 600 @@ -451,10 +451,10 @@ 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 - ++ [PS (x1,y1-10) (-pi/2) $ PutCrit autoCrit - ,PS (x2,y2-10) (-pi/2) $ PutCrit autoCrit - ,PS (x3,y3-10) (-pi/2) $ PutCrit autoCrit - ,PS (w/2,200) 0 putLamp + ++ [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 ] return $ set rmPS plmnts $ roomRectAutoLinks w 600 @@ -480,16 +480,16 @@ pistolerRoom = do aa <- state $ randomR (0,2*pi) ab <- state $ randomR (0,2*pi) ac <- state $ randomR (0,2*pi) - let plmnts = [PS (ps !! 0) aa $ PutCrit pistolCrit - ,PS (ps !! 1) ab $ PutCrit pistolCrit - ,PS (ps !! 2) ac $ PutCrit pistolCrit - ,PS (w/2,h-50) 0 putLamp - ,PS (w/2,50) 0 putLamp - ,PS (w-5,h-5) 0 putLamp - ,PS (5,h-5) 0 putLamp - ,PS (w-5,5) 0 putLamp - ,PS (5,5) 0 putLamp - ,PS (w/2,h/2) 0 putLamp + 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 ] ++ concat [f x y | x<-xs,y<-ys] @@ -515,13 +515,13 @@ spawnerRoom :: RandomGen g => State g (Tree (Either Room Room)) spawnerRoom = do x <- state $ randomR (250,300) y <- state $ randomR (300,400) - wl <- takeOne [PS (0,0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10)) + wl <- takeOne [sPS (0,0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10)) defaultCrystalWall ,windowLine (x/2,0) (x/2,y-60) ] - let plmnts = [PS (x/4, y/4) (pi/2) $ PutCrit spawnerCrit + let plmnts = [sPS (x/4, y/4) (pi/2) $ PutCrit spawnerCrit ,wl - ,PS (x/2, y-10) 0 putLamp + ,sPS (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) diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index 5d3359b7f..f3f87e8eb 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -22,9 +22,9 @@ airlockOneWay n = Room { _rmPolys = [rectNSWE 90 0 0 40] , _rmLinks = lnks , _rmPath = [] - , _rmPS = [PS (0,15) 0 $ PutDoubleDoor col (not . cond) (0,0) (0,40) - ,PS (0,75) 0 $ PutDoubleDoor col cond (0,0) (0,40) - ,PS (35,45) (pi/2) $ PutButton $ makeButton col (over worldState + , _rmPS = [sPS (0,15) 0 $ PutDoubleDoor col (not . cond) (0,0) (0,40) + ,sPS (0,75) 0 $ PutDoubleDoor col cond (0,0) (0,40) + ,sPS (35,45) (pi/2) $ PutButton $ makeButton col (over worldState (M.insert (DoorNumOpen n) True)) ] --, _rmBound = rectNSWE 90 30 (-30) 30 @@ -59,12 +59,12 @@ airlock0 n = Room ,((20,45),(20, 5)) ] , _rmPS = - [PS (0,20) 0 $ PutDoubleDoor col (not . cond) (1,0) (39,0) - ,PS (0,80) 0 $ PutDoubleDoor col cond (1,0) (39,0) - ,PS (35,50) (pi/2) $ PutButton $ makeSwitch col + [sPS (0,20) 0 $ PutDoubleDoor col (not . cond) (1,0) (39,0) + ,sPS (0,80) 0 $ PutDoubleDoor col cond (1,0) (39,0) + ,sPS (35,50) (pi/2) $ PutButton $ makeSwitch col (over worldState (M.insert (DoorNumOpen n) True)) (over worldState (M.insert (DoorNumOpen n) False)) - ,PS (-25, 50) 0 putLamp + ,sPS (-25, 50) 0 putLamp ] , _rmBound = [rectNSWE 75 15 0 40] } @@ -98,11 +98,11 @@ airlock90 n = Room ,((40,0),(0,40)) ] , _rmPS = - [PS (5,5) 0 $ PutDoor col (not . cond) pss - ,PS (120,120) (3* pi/4) $ PutButton $ makeSwitch col + [sPS (5,5) 0 $ PutDoor col (not . cond) pss + ,sPS (120,120) (3* pi/4) $ PutButton $ makeSwitch col (over worldState (M.insert (DoorNumOpen n) True)) (over worldState (M.insert (DoorNumOpen n) False)) - ,PS (60, 60) 0 putLamp + ,sPS (60, 60) 0 putLamp ] , _rmBound = [[ (10,10) @@ -138,13 +138,13 @@ airlockCrystal n = Room [ ] , _rmPS = - [PS (0,0) 0 $ PutDoor col (not . cond) pss - ,PS (145,70) (pi/2) $ PutButton $ makeSwitch col + [sPS (0,0) 0 $ PutDoor col (not . cond) pss + ,sPS (145,70) (pi/2) $ PutButton $ makeSwitch col (over worldState (M.insert (DoorNumOpen n) True)) (over worldState (M.insert (DoorNumOpen n) False)) ,crystalLine (0,70) (40,70) - ,PS (20, 40) 0 putLamp - ,PS (20, 100) 0 putLamp + ,sPS (20, 40) 0 putLamp + ,sPS (20, 100) 0 putLamp ] , _rmBound = [ ] diff --git a/src/Dodge/Room/Boss.hs b/src/Dodge/Room/Boss.hs index 2dbcb4f0e..50513ce6f 100644 --- a/src/Dodge/Room/Boss.hs +++ b/src/Dodge/Room/Boss.hs @@ -34,10 +34,10 @@ roomGlassOctogon x = Room , _rmPath = [((0,x),(0,-(x+40))) ,((0,-(x+40)),(0,x))] , _rmPS = - [PS (fx,fx) 0 putLamp - ,PS (-fx,fx) 0 putLamp - ,PS (fx,-fx) 0 putLamp - ,PS (-fx,-fx) 0 putLamp + [sPS (fx,fx) 0 putLamp + ,sPS (-fx,fx) 0 putLamp + ,sPS (fx,-fx) 0 putLamp + ,sPS (-fx,-fx) 0 putLamp ,crystalLine (-x,x/2) (negate (x/2), x) ,crystalLine (x,x/2) (x/2, x) ,crystalLine (x/2,-x) (x,negate (x/2)) @@ -50,13 +50,13 @@ roomGlassOctogon x = Room fx = 4 * x / 5 bossRoom :: RandomGen g => Creature -> State g Room -bossRoom cr = randomMediumRoom <&> rmPS %~ ( PS (0,100) (negate $ pi/2) (PutCrit cr) :) +bossRoom cr = randomMediumRoom <&> rmPS %~ ( sPS (0,100) (negate $ pi/2) (PutCrit cr) :) armouredChasers :: RandomGen g => State g (Tree Room) armouredChasers = do ps <- takeN 5 [(x,y) | x <- [-100,-80 .. 100] ,y <- [-100,-80 .. 100] ] as <- replicateM 5 . state $ randomR (0,2*pi) - let theCrits = zipWith3 (\p a c -> PS p a (PutCrit c)) ps as cs + let theCrits = zipWith3 (\p a c -> sPS p a (PutCrit c)) ps as cs treeFromPost [corridor,corridor] <$> (randomMediumRoom <&> rmPS %~ (++ theCrits)) where cs = (armourChaseCrit & crState . crDropsOnDeath .~ DropSpecific [0]) @@ -90,10 +90,10 @@ roomCross x y = Room ] , _rmPath = [] , _rmPS = - [PS ( x, 0) 0 putLamp - ,PS (-x, 0) 0 putLamp - ,PS ( 0, x) 0 putLamp - ,PS ( 0,-x) 0 putLamp + [sPS ( x, 0) 0 putLamp + ,sPS (-x, 0) 0 putLamp + ,sPS ( 0, x) 0 putLamp + ,sPS ( 0,-x) 0 putLamp ] , _rmBound = [rectNSWE y (-y) (-x) x @@ -116,7 +116,7 @@ roomShuriken x y = { _rmPolys = ps , _rmLinks = [((x-1,y-20),negate $ pi/2)] , _rmPath = [] - , _rmPS = [PS (x/2,x/2) 0 putLamp] + , _rmPS = [sPS (x/2,x/2) 0 putLamp] , _rmBound = ps } in foldr1 combineRooms $ map (\r -> shiftRoomBy ((0,0), r) corner) [0,pi/2,pi,3*pi/2] @@ -140,7 +140,7 @@ roomTwistCross x y z = { _rmPolys = ps , _rmLinks = [((z,y-20), pi/2)] , _rmPath = [] - , _rmPS = [PS (x/2,x/2) 0 putLamp] + , _rmPS = [sPS (x/2,x/2) 0 putLamp] , _rmBound = ps } in foldr1 combineRooms $ map (\r -> shiftRoomBy ((0,0), r) corner) [0,pi/2,pi,3*pi/2] diff --git a/src/Dodge/Room/Data.hs b/src/Dodge/Room/Data.hs index 9a0ee32b7..a0478bad0 100644 --- a/src/Dodge/Room/Data.hs +++ b/src/Dodge/Room/Data.hs @@ -20,7 +20,7 @@ data Room = Room { _rmPolys :: [ [Point2] ] , _rmLinks :: [(Point2,Float)] , _rmPath :: [(Point2, Point2)] - , _rmPS :: [PlacementSpot] + , _rmPS :: [Placement] , _rmBound :: [ [Point2] ] } makeLenses ''Room diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index 6fb7d57e5..1fa6fc549 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -16,7 +16,7 @@ door = Room , _rmLinks = lnks , _rmPath = [((20,35),(20,5))] -- door extends into side walls (for shadows as rendered 12/03) - , _rmPS = [PS (0,20) 0 $ PutAutoDoor (0,0) (40,0)] + , _rmPS = [sPS (0,20) 0 $ PutAutoDoor (0,0) (40,0)] , _rmBound = [] } where lnks = [((20,35),0) diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index f7ee5b26b..773d7e753 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -73,9 +73,13 @@ shiftRoomBy shift@(pos,rot) r = r shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot) -shiftPSBy (pos,rot) ps = case ps of - PS {} -> over psPos (shiftPointBy (pos,rot)) - $ over psRot (+rot) - ps +shiftPSBy (pos,rot) ps = ps + & placementSpot . psPos %~ shiftPointBy (pos,rot) + & placementSpot . psRot %~ (+ rot) + +--shiftPSBy (pos,rot) ps = case ps of +-- PS {} -> over psPos (shiftPointBy (pos,rot)) +-- $ over psRot (+rot) +-- ps shiftPathPointBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 139068b78..f2192d4ab 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -38,12 +38,12 @@ twinSlowDoorRoom drID w h x = Room ] , _rmPath = [] , _rmPS = - [ PS (0,h/2) 0 putLamp - , PS (25,5) 0 putLamp - , PS (negate 25,5) 0 putLamp - , PS (0,0) 0 $ PutDoor col (not . cond) drL - , PS (0,0) 0 $ PutDoor col (not . cond) drR - , PS (0,h-5) pi $ PutButton $ makeButton col + [ sPS (0,h/2) 0 putLamp + , sPS (25,5) 0 putLamp + , sPS (negate 25,5) 0 putLamp + , sPS (0,0) 0 $ PutDoor col (not . cond) drL + , sPS (0,0) 0 $ PutDoor col (not . cond) drR + , sPS (0,h-5) pi $ PutButton $ makeButton col (over worldState (M.insert (DoorNumOpen drID) True)) ] , _rmBound = ps @@ -69,7 +69,7 @@ twinSlowDoorChasers drid = do let lps = (-65 ,) <$> [20,40 .. 180] rps = (65 ,) <$> [20,40 .. 180] ps <- takeN 4 $ lps ++ rps - let plmnts = map (\p -> PS p 0 $ PutCrit chaseCrit) ps + let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps return $ twinSlowDoorRoom drid 80 200 40 & rmPS %~ (plmnts ++) slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room)) @@ -88,9 +88,9 @@ slowDoorRoom = do let ps = zip xs ys xs' <- replicateM 5 $ state $ randomR (10,x-10) ys' <- replicateM 5 $ state $ randomR (h+20,y) - let crits = zipWith (\p r -> PS p r randC1) ps rs - lsources = [PS (x/2,30) 0 putLamp, PS (x/2,y-30) 0 putLamp] - barrels = zipWith (\x y -> PS (x,y) 0 $ PutCrit explosiveBarrel) xs' ys' + let crits = zipWith (\p r -> sPS p r randC1) ps rs + lsources = [sPS (x/2,30) 0 putLamp, sPS (x/2,y-30) 0 putLamp] + barrels = zipWith (\x y -> sPS (x,y) 0 $ PutCrit explosiveBarrel) xs' ys' pillarsa = [] pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20) ++ putBlockRect (2*x/5-20) (2*x/5+20) (h/2-20) (h/2+20) @@ -107,7 +107,7 @@ slowDoorRoom = do fmap connectRoom (filterLinks cond =<< changeLinkTo cond2 - (set rmPS ([PS (0,0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources) + (set rmPS ([sPS (0,0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources) $ roomRectAutoLinks x y ) ) diff --git a/src/Dodge/Room/NoNeedWeapon.hs b/src/Dodge/Room/NoNeedWeapon.hs index fcdbc4e70..2eb76f5e0 100644 --- a/src/Dodge/Room/NoNeedWeapon.hs +++ b/src/Dodge/Room/NoNeedWeapon.hs @@ -29,11 +29,11 @@ centerVaultExplosiveExit centerVaultExplosiveExit drID = do cr <- takeOne [miniGunCrit, autoCrit] let extraPS = - [PS (0,175) 0 $ PutCrit explosiveBarrel - ,PS (5,195) 0 $ PutCrit explosiveBarrel - ,PS (0,200) 0 $ PutCrit explosiveBarrel - ,PS (-4,195) 0 $ PutCrit explosiveBarrel - ,PS (0,0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll) + [sPS (0,175) 0 $ PutCrit explosiveBarrel + ,sPS (5,195) 0 $ PutCrit explosiveBarrel + ,sPS (0,200) 0 $ PutCrit explosiveBarrel + ,sPS (-4,195) 0 $ PutCrit explosiveBarrel + ,sPS (0,0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll) ] r <- centerVaultRoom drID 200 200 50 <&> rmPS %~ (extraPS ++) randomiseLinksBy shuffleTail r <&> rmLinks %~ take 2 diff --git a/src/Dodge/Room/Placement.hs b/src/Dodge/Room/Placement.hs index d7ef5952c..45bfe054a 100644 --- a/src/Dodge/Room/Placement.hs +++ b/src/Dodge/Room/Placement.hs @@ -15,15 +15,15 @@ import Control.Lens putLamp = PutCrit lamp -singleBlock :: Point2 -> [PlacementSpot] -singleBlock a = [PS a 0 $ PutBlock [5,20,20] (greyN 0.5) +singleBlock :: Point2 -> [Placement] +singleBlock a = [sPS a 0 $ PutBlock [5,20,20] (greyN 0.5) $ reverse $ rectNSWE 10 (-10) (-10) 10] {- Places a line of blocks between two points. Width 9, also extends out from each point by 9. -} -blockLine :: Point2 -> Point2 -> PlacementSpot -blockLine a b = PS +blockLine :: Point2 -> Point2 -> Placement +blockLine a b = SinglePlacement $ PS { _psPos = (0,0) , _psRot = 0 , _psType = PutLineBlock baseBlockPane 9 9 a b @@ -33,8 +33,8 @@ blockLine a b = PS Places an breakable window between two points. Width 8, also extends out from each point by 8. -} -windowLine :: Point2 -> Point2 -> PlacementSpot -windowLine a b = PS +windowLine :: Point2 -> Point2 -> Placement +windowLine a b = SinglePlacement $ PS { _psPos = (0,0) , _psRot = 0 , _psType = PutLineBlock baseWindowPane 8 8 a b @@ -44,8 +44,8 @@ windowLine a b = PS Places an unbreakable window between two points. Width 7, also extends out from each point by 7. -} -crystalLine :: Point2 -> Point2 -> PlacementSpot -crystalLine a b = PS +crystalLine :: Point2 -> Point2 -> Placement +crystalLine a b = SinglePlacement $ PS { _psPos = (0,0) , _psRot = 0 , _psType = PutWall ps defaultCrystalWall @@ -62,8 +62,8 @@ crystalLine a b = PS {- Places an unbreakable wall between two points. Depth 15, does not extend wider than points. -} -wallLine :: Point2 -> Point2 -> PlacementSpot -wallLine a b = PS +wallLine :: Point2 -> Point2 -> Placement +wallLine a b = SinglePlacement $ PS { _psPos = (0,0) , _psRot = 0 , _psType = PutWall ps defaultWall @@ -114,7 +114,7 @@ replacePutID -> Room -> Room replacePutID i psts r = - r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & psType .~ pt)) psts + r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & placementSpot . psType .~ pt)) psts {- Partition a list by a predicate, apply a zip to those elements that satisfy the predicate, concatenate the new zipped list and the other (unchanged) half. -} @@ -128,7 +128,7 @@ subZipWith f g xs ys = let (zs,ws) = partition f xs in zipWith g zs ys ++ ws -isPutID i ps = Just i == ps ^? psType . putID +isPutID i ps = Just i == ps ^? placementSpot . psType . putID putBlockRect a x b y = [ blockLine (a,b) (a,y) , blockLine (a,y) (x,y) diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index 0c8c2d7d6..1545f18af 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -43,7 +43,7 @@ roomRect x y xn yn = Room { _rmPolys = [rectNSWE y 0 0 x ] , _rmLinks = lnks , _rmPath = concatMap doublePair pth - , _rmPS = [PS (x/2,y/2) 0 putLamp] + , _rmPS = [sPS (x/2,y/2) 0 putLamp] , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)] } where @@ -103,7 +103,7 @@ fourth w = Room , _rmLinks = [((0,w), 0)] , _rmPath = [((0,w),(0,0)),((0,0),(0,w))] , _rmPS = - [PS (0,w/2) 0 putLamp + [sPS (0,w/2) 0 putLamp ] , _rmBound = [[(0,0),(w,w),(-w,w)]] } @@ -112,19 +112,19 @@ Add a light and a 'PutNothing' placement. -} fourthWall :: RandomGen g => Float -> State g Room fourthWall w = do b <- takeOne - [ [ PS (20-w,w-40) 0 putLamp - , PS (0,40) 0 putLamp - , PS (w-20,w-20) pi PutNothing + [ [ sPS (20-w,w-40) 0 putLamp + , sPS (0,40) 0 putLamp + , sPS (w-20,w-20) pi PutNothing , blockLine (w/2,w/2) (w/2,w) ] - , [ PS (20-w,w-40) 0 putLamp - , PS (0,40) 0 putLamp - , PS (w-20,w-20) pi PutNothing + , [ sPS (20-w,w-40) 0 putLamp + , sPS (0,40) 0 putLamp + , sPS (w-20,w-20) pi PutNothing , blockLine (w/2,w/2) (negate $ w/2,w/2) ] - , [ PS (20-w,w-40) 0 putLamp - , PS (0,20) 0 putLamp - , PS (w-20,w-20) pi PutNothing + , [ sPS (20-w,w-40) 0 putLamp + , sPS (0,20) 0 putLamp + , sPS (w-20,w-20) pi PutNothing , blockLine (w/2,w/2) (0,w/2) , blockLine (-29,w) (0,w/2) ] @@ -145,32 +145,32 @@ fourthCorner w = Room ,((negate $ w/2,3*w/2), pi/4) ] , _rmPath = [((0,w),(0,0)),((0,0),(0,w))] - , _rmPS = [PS (0,w) 0 putLamp] + , _rmPS = [sPS (0,w) 0 putLamp] , _rmBound = [[(w,w),(0,2*w),(-w,w)]] } fourthCornerWall :: RandomGen g => Float -> State g Room fourthCornerWall w = do b <- takeOne - [ [ PS (10-w,w) 0 putLamp - , PS (w-10,w) 0 putLamp - , PS (0,10) 0 putLamp - , PS (0,2*w-20) pi PutNothing + [ [ sPS (10-w,w) 0 putLamp + , sPS (w-10,w) 0 putLamp + , sPS (0,10) 0 putLamp + , sPS (0,2*w-20) pi PutNothing , blockLine (w/2,w/2) (0,w) , blockLine (negate $ w/2,w/2) (0,w) ] - , [ PS (0,3*w/2) 0 putLamp - , PS (w-10,w) 0 putLamp - , PS (10-w,w-20) 0 putLamp - , PS (0,10) 0 putLamp - , PS (0,2*w-20) pi PutNothing + , [ sPS (0,3*w/2) 0 putLamp + , sPS (w-10,w) 0 putLamp + , sPS (10-w,w-20) 0 putLamp + , sPS (0,10) 0 putLamp + , sPS (0,2*w-20) pi PutNothing , blockLine (w/2,w/2) (0,w) , blockLine (negate w,w) (0,w) ] - , [ PS (10-w,w) 0 putLamp - , PS (w-10,w) 0 putLamp - , PS (0,10) 0 putLamp - , PS (20,2*w-40) pi PutNothing + , [ sPS (10-w,w) 0 putLamp + , sPS (w-10,w) 0 putLamp + , sPS (0,10) 0 putLamp + , sPS (20,2*w-40) pi PutNothing , blockLine (w/2,w/2) (0,w) , blockLine (0,w) (0,w*2) ] @@ -190,7 +190,7 @@ fillNothingPlacement :: PSType -> Room -> Room fillNothingPlacement pst r = r & rmPS %~ replaceNothingWith pst where - replaceNothingWith x (PS p rot PutNothing: pss) = PS p rot x : pss + replaceNothingWith x (SinglePlacement (PS p rot PutNothing): pss) = sPS p rot x : pss replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss replaceNothingWith _ [] = [] {- | Successively fill 'PutNothing' placements with a list of given 'PSType's. @@ -243,11 +243,11 @@ centerVaultRoom n w h d = do ] , _rmPath = [] , _rmPS = - [PS (d-25,d-25) 0 putLamp - ,PS (w-5,h-5) 0 putLamp - ,PS (w-5,5-h) 0 putLamp - ,PS (5-w,h-5) 0 putLamp - ,PS (5-w,5-h) 0 putLamp + [sPS (d-25,d-25) 0 putLamp + ,sPS (w-5,h-5) 0 putLamp + ,sPS (w-5,5-h) 0 putLamp + ,sPS (5-w,h-5) 0 putLamp + ,sPS (5-w,5-h) 0 putLamp ] ++ concat (zipWith (\i r -> map (shiftPSBy ((0,0),r)) $ theDoor i) [n, n+1, n+2, n+3] [0,pi/2,pi,3*pi/2]) @@ -256,8 +256,8 @@ centerVaultRoom n w h d = do where col = dim $ dim $ bright red theDoor i = - [ PS (0,d-10) 0 $ PutDoubleDoor col (cond i) (-19,0) (19,0) - , PS (35,d+4) 0 $ PutButton $ makeSwitch col + [ sPS (0,d-10) 0 $ PutDoubleDoor col (cond i) (-19,0) (19,0) + , sPS (35,d+4) 0 $ PutButton $ makeSwitch col (over worldState (M.insert (DoorNumOpen i) True)) (over worldState (M.insert (DoorNumOpen i) False)) ] diff --git a/src/Dodge/Room/RoadBlock.hs b/src/Dodge/Room/RoadBlock.hs index 85ee2c2f7..94115032a 100644 --- a/src/Dodge/Room/RoadBlock.hs +++ b/src/Dodge/Room/RoadBlock.hs @@ -40,12 +40,12 @@ litCorridor90 = do ,((40,h-40),(20,h-40)) ] , _rmPS = - [ PS (20,h-5) 0 putLamp + [ sPS (20,h-5) 0 putLamp , windowLine (0,h-20) (40,h-20) - , PS (-50,h-85) 0 putLamp + , sPS (-50,h-85) 0 putLamp , windowLine (-40,h-60) (-40,h-100) - , PS ( 20,h-40) 0 $ PutID 0 - , PS (-20,h-80) 0 $ PutID 2 + , sPS ( 20,h-40) 0 $ PutID 0 + , sPS (-20,h-80) 0 $ PutID 2 ] , _rmBound = [poly] } @@ -59,9 +59,9 @@ longBlockedCorridor :: RandomGen g => State g (Tree (Either Room Room)) longBlockedCorridor = do r <- state $ randomR (0,pi) n <- state $ randomR (0,3) - let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256) + let plmnts = [sPS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256) $ reverse $ rectNSWE 10 (-10) (-10) 10 - ,PS (20,15) 0 putLamp + ,sPS (20,15) 0 putLamp ] sequence $ treeFromPost (replicate n $ Left <$> randomiseOutLinks corridor) $ return $ Right $ set rmPS plmnts corridor @@ -70,8 +70,8 @@ longBlockedCorridor = do blockedCorridor :: RandomGen g => State g (Tree (Either Room Room)) blockedCorridor = do r <- state $ randomR (0,pi) - let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256) + let plmnts = [sPS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256) $ reverse $ rectNSWE 10 (-10) (-10) 10 - ,PS (20,15) 0 putLamp + ,sPS (20,15) 0 putLamp ] sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor diff --git a/src/Dodge/Room/Teleport.hs b/src/Dodge/Room/Teleport.hs index 3898683dd..51d0d63d0 100644 --- a/src/Dodge/Room/Teleport.hs +++ b/src/Dodge/Room/Teleport.hs @@ -28,8 +28,8 @@ telRoomLev i = do w <- state $ randomR (200,300) h <- state $ randomR (200,300) return $ roomRectAutoLinks w h & rmPS .~ - [ PS (w/2,h/2) 0 $ PutPressPlate telPP - , PS (w/2,h/2+ 30) 0 putLamp + [ sPS (w/2,h/2) 0 $ PutPressPlate telPP + , sPS (w/2,h/2+ 30) 0 putLamp ] where telPP = PressPlate diff --git a/src/Dodge/Room/Treasure.hs b/src/Dodge/Room/Treasure.hs index 4b0fc6d73..871e3e83b 100644 --- a/src/Dodge/Room/Treasure.hs +++ b/src/Dodge/Room/Treasure.hs @@ -1,4 +1,4 @@ -{- +{- | Rooms that contain valuable items, typically protected in some manner. Typically dead ends. -} @@ -13,13 +13,10 @@ import Dodge.LevelGen.Data import Data.List import Control.Monad.State import Control.Lens -import System.Random - -{- -A triangular room with loot at the top (with 'PutID' 2), +import System.Random +{- | A triangular room with loot at the top (with 'PutID' 2), creatures in the bottom two corners (with 'PutID' 0), -and (single) entrance bottom middle. --} +and (single) entrance bottom middle. -} triLootRoom :: Float -- Width -> Float -- Height @@ -31,13 +28,13 @@ triLootRoom w h = pure $ Room , _rmLinks = [((0,-80),pi)] , _rmPath = doublePair ((0,-80),(0,h/2)) , _rmPS = - [PS (15-w,15) 0 $ PutID 0 - ,PS (w-15,15) pi $ PutID 0 - ,PS (0,h-35) 0 $ PutID 2 - ,PS (-5,h-10) 0 putLamp - ,PS (5,h-10) 0 putLamp - ,PS (0,h-15) 0 putLamp - ,PS (0,-60) 0 putLamp + [sPS (15-w, 15) 0 $ PutID 0 + ,sPS (w-15, 15) pi $ PutID 0 + ,sPS ( 0,h-35) 0 $ PutID 2 + ,sPS ( -5,h-10) 0 putLamp + ,sPS ( 5,h-10) 0 putLamp + ,sPS ( 0,h-15) 0 putLamp + ,sPS ( 0, -60) 0 putLamp ] , _rmBound = [tri , base] } @@ -50,10 +47,8 @@ triLootRoom w h = pure $ Room , ( 20, h) , (-20, h) ] - base = rectNSWE 20 (-80) (-20) 20 - -{- Create a random room with one entrance containing given creatures and items. - -} + base = rectNSWE 20 (-80) (-20) 20 +{- | Create a random room with one entrance containing given creatures and items. -} lootRoom :: RandomGen g => [Creature] -> [Item] -> State g Room lootRoom crs itms = do let w = 300