Move toward better info display during level generation
This commit is contained in:
+6
-6
@@ -82,7 +82,6 @@ data World = World
|
||||
, _pathGraph :: ~(Gr Point2 Float)
|
||||
, _pathGraphP :: ~[(Point2,Point2)]
|
||||
, _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
|
||||
, _savedWorlds :: M.Map SaveSlot World
|
||||
, _menuLayers :: [ScreenLayer]
|
||||
, _worldFlags :: S.Set WorldFlag
|
||||
, _carteDisplay :: !Bool
|
||||
@@ -94,16 +93,17 @@ data World = World
|
||||
, _closeActiveObjects :: [Either FloorItem Button]
|
||||
, _seenLocations :: IM.IntMap (World -> Point2,String)
|
||||
, _selLocation :: Int
|
||||
, _keyConfig :: KeyConfigSDL
|
||||
, _config :: Configuration
|
||||
, _sideEffects :: World -> IO World
|
||||
, _inventoryMode :: InventoryMode
|
||||
, _lClickHammer :: HammerPosition
|
||||
, _radDistortion :: [(Point2,Point2,Point2,Float)]
|
||||
, _gameRooms :: [GameRoom]
|
||||
, _preloadData :: PreloadData
|
||||
, _frameClock :: Int
|
||||
, _worldBounds :: Bounds
|
||||
, _gameRooms :: [GameRoom]
|
||||
, _keyConfig :: KeyConfigSDL
|
||||
, _config :: Configuration
|
||||
, _preloadData :: PreloadData
|
||||
, _savedWorlds :: M.Map SaveSlot World
|
||||
, _frameClock :: Int
|
||||
}
|
||||
data SaveSlot = QuicksaveSlot | LevelStartSlot
|
||||
deriving (Eq,Ord)
|
||||
|
||||
+7
-7
@@ -22,6 +22,7 @@ import Dodge.Layout.Tree.Shift
|
||||
import Dodge.Creature
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.Item.Weapon.Launcher
|
||||
import MonadHelp
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad.State
|
||||
@@ -34,21 +35,18 @@ initialRoomTree = do
|
||||
let t' = padCorridors struct
|
||||
t = treeFromTrunk
|
||||
[[StartRoom]
|
||||
,[SpecificRoom spawnerRoom]
|
||||
,[Corridor]
|
||||
,[Corridor]
|
||||
,[SpecificRoom $ fmap connectRoom pistolerRoom]
|
||||
,[Corridor]
|
||||
,[Corridor]
|
||||
-- ,[Corridor]
|
||||
-- ,[Corridor]
|
||||
-- ,[Corridor]
|
||||
,[SpecificRoom $ return $ connectRoom lasTunnel ]
|
||||
,[Corridor]
|
||||
,[SpecificRoom $ fmap connectRoom slowDoorRoom ]
|
||||
,[Corridor]
|
||||
,[Corridor]
|
||||
,[Corridor]
|
||||
,[SpecificRoom roomCCrits]
|
||||
,[SpecificRoom $ fmap connectRoom roomCCrits]
|
||||
,[Corridor]
|
||||
,[AirlockAno]
|
||||
,[Corridor]
|
||||
@@ -99,5 +97,7 @@ initialRoomTree = do
|
||||
t'
|
||||
shiftExpandTree . expandTreeBy id <$> mapM annoToRoomTree t
|
||||
|
||||
levx :: RandomGen g => Int -> State g [Room]
|
||||
levx _ = untilJust initialRoomTree
|
||||
levx :: RandomGen g => Int -> State g ([Room] , Int)
|
||||
levx _ = untilJustCount initialRoomTree
|
||||
|
||||
|
||||
|
||||
+18
-24
@@ -4,34 +4,41 @@ import Dodge.Save
|
||||
import Dodge.Data
|
||||
import Dodge.Data.SoundOrigin
|
||||
import Dodge.Creature
|
||||
--import Dodge.Zone
|
||||
import Dodge.Floor
|
||||
import Dodge.Layout
|
||||
import Dodge.Story
|
||||
import Dodge.WorldEvent.Cloud
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.SoundLogic.LoadSound
|
||||
--import Dodge.Creature.Perception
|
||||
import Geometry.Data
|
||||
--import Shape.Data
|
||||
--import Dodge.Render.Shape
|
||||
--import Picture
|
||||
--import Dodge.GameRoom
|
||||
--import Geometry
|
||||
import Dodge.Room.Data
|
||||
|
||||
import System.Random
|
||||
import System.Timeout
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified Data.Map as M
|
||||
--import Control.Lens
|
||||
--import Data.Maybe
|
||||
import Control.Monad.State
|
||||
|
||||
firstWorld :: IO World
|
||||
firstWorld = do
|
||||
-- i <- randomRIO (0,5000)
|
||||
let i = 2
|
||||
let i = 3
|
||||
putStrLn $ "Seed for level generation: " ++ show ( i :: Int)
|
||||
return $ generateLevelFromRoomList (levx 1) $ initialWorld {_randGen = mkStdGen i}
|
||||
let g = mkStdGen i
|
||||
(roomList,n) <- f g
|
||||
putStrLn $ "Had to go through "++ show n ++ " random generators"
|
||||
return $ generateLevelFromRoomList roomList $ initialWorld {_randGen = g}
|
||||
where
|
||||
f :: StdGen -> IO ([Room],Int)
|
||||
f g = do
|
||||
mayrs <- timeout 10000000 . return $ evalState (levx 1) g
|
||||
case mayrs of
|
||||
Nothing -> do
|
||||
let i = fst $ random g
|
||||
putStrLn $ "Timeout; trying new seed: " ++ show i
|
||||
f (mkStdGen i)
|
||||
Just rs -> return rs
|
||||
|
||||
initialWorld :: World
|
||||
initialWorld = defaultWorld
|
||||
@@ -58,16 +65,3 @@ initialWorld = defaultWorld
|
||||
|
||||
testStringInit :: World -> [String]
|
||||
testStringInit _ = []
|
||||
--testStringInit = mapMaybe f . IM.elems . flattenIMIMIM . _znObjects . _wallsZone
|
||||
-- where
|
||||
-- f dr | _wlColor dr == V4 0 1 0 1 = Just . show $ _wlLine dr
|
||||
-- | otherwise = Nothing
|
||||
--testStringInit _ = []
|
||||
--testStringInit w = [show . length $ newSounds w]
|
||||
--testStringInit w = (show . _crPos $ _creatures w IM.! 0)
|
||||
-- : (map show . _grBound . last $ sortOn _grName grs)
|
||||
-- ++ closeRooms
|
||||
-- where
|
||||
-- closeRooms = map _grName $ filter (pointInOrOnPolygon p . _grBound) grs
|
||||
-- grs = _gameRooms w
|
||||
-- p = _cameraViewFrom w
|
||||
|
||||
@@ -48,6 +48,7 @@ import Dodge.Default
|
||||
import Sound.Data
|
||||
import Geometry
|
||||
import Geometry.Vector3D
|
||||
--import Data.Preload
|
||||
|
||||
import System.Random
|
||||
import Control.Lens
|
||||
|
||||
+4
-4
@@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
--{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Layout
|
||||
where
|
||||
import Dodge.Data
|
||||
@@ -27,7 +27,7 @@ import Polyhedra
|
||||
import Polyhedra.Data
|
||||
|
||||
import Data.List (nubBy)
|
||||
import Control.Monad.State
|
||||
--import Control.Monad.State
|
||||
import Control.Lens
|
||||
import System.Random
|
||||
import Data.Tree
|
||||
@@ -37,7 +37,7 @@ import Data.Foldable
|
||||
import qualified Control.Foldl as L
|
||||
import Data.Maybe
|
||||
|
||||
generateLevelFromRoomList :: State StdGen [Room] -> World -> World
|
||||
generateLevelFromRoomList :: [Room] -> World -> World
|
||||
generateLevelFromRoomList gr w
|
||||
= initWallZoning
|
||||
. setupWorldBounds
|
||||
@@ -51,7 +51,7 @@ generateLevelFromRoomList gr w
|
||||
where
|
||||
path = pairsToGraph dist pairPath
|
||||
pairPath = concatMap _rmPath rs
|
||||
rs = zipWith addTile zs . evalState gr $ _randGen w
|
||||
rs = zipWith addTile zs gr
|
||||
zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
|
||||
|
||||
doRoomPlacements :: World -> Room -> World
|
||||
|
||||
@@ -24,14 +24,14 @@ shiftRoomTreeSearchAll
|
||||
-> [[Room]]
|
||||
shiftRoomTreeSearchAll _ Empty = [[]]
|
||||
shiftRoomTreeSearchAll bs (Node r ts :<| tseq)
|
||||
| roomIsClipping = [] -- this is called too often--might get memoized?
|
||||
| otherwise = case ts of
|
||||
[] -> (r :) <$> shiftRoomTreeSearchAll newBounds tseq
|
||||
(s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (useLink l) ss <| (tseq |> f l s))) ls
|
||||
-- = case ts of
|
||||
-- [] | roomIsClipping -> []
|
||||
-- | roomIsClipping = [] -- this is called too often--might get memoized?
|
||||
-- | otherwise = case ts of
|
||||
-- [] -> (r :) <$> shiftRoomTreeSearchAll newBounds tseq
|
||||
-- (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (useLink l) ss <| (tseq |> f l s))) ls
|
||||
= case ts of
|
||||
[] | roomIsClipping -> []
|
||||
[] -> (r :) <$> shiftRoomTreeSearchAll newBounds tseq
|
||||
(s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (useLink l) ss <| (tseq |> f l s))) ls
|
||||
where
|
||||
convexBounds = map pointsToPoly $ _rmBound r
|
||||
ls = init $ _rmLinks r
|
||||
|
||||
+6
-9
@@ -12,14 +12,15 @@ import Dodge.Config.Data
|
||||
import Dodge.Config.Update
|
||||
import SDL
|
||||
import SDL.Internal.Numbered
|
||||
import Dodge.Layout
|
||||
import Dodge.Floor
|
||||
--import Dodge.Layout
|
||||
--import Dodge.Floor
|
||||
import Dodge.Initialisation
|
||||
import Preload.Update
|
||||
import Dodge.Base.Window
|
||||
import Dodge.SoundLogic
|
||||
|
||||
import Control.Lens
|
||||
--import Control.Monad.State
|
||||
optionMenu :: ScreenLayer
|
||||
optionMenu = OptionScreen
|
||||
{ _scTitle = const "OPTIONS"
|
||||
@@ -159,13 +160,9 @@ pauseMenuOptions =
|
||||
startNewGame :: World -> Maybe World
|
||||
startNewGame w = Just $ w
|
||||
& menuLayers .~ [WaitScreen (const "GENERATING...") 1]
|
||||
& worldEvents .~ const aNewGame
|
||||
where
|
||||
aNewGame :: World
|
||||
aNewGame = updateFramebufferSize $ generateLevelFromRoomList (levx 1) $ initialWorld
|
||||
& randGen .~ _randGen w
|
||||
& config .~ _config w
|
||||
& preloadData .~ _preloadData w
|
||||
-- & worldEvents .~ const aNewGame
|
||||
& sideEffects .~ const (firstWorld <&> keyConfig .~ _keyConfig w <&> config .~ _config w
|
||||
<&> preloadData .~ _preloadData w) -- this kills save games etc...
|
||||
|
||||
-- | hacky
|
||||
scodeToChar :: Scancode -> Char
|
||||
|
||||
+44
-57
@@ -34,26 +34,22 @@ import System.Random
|
||||
import Data.Tree
|
||||
import Data.Bifunctor
|
||||
|
||||
roomC :: Float -> Float -> Room
|
||||
roomC x y = defaultRoom
|
||||
{ _rmPolys = [rectNSWE y 0 0 x]
|
||||
, _rmLinks = lnks
|
||||
, _rmPath = pth
|
||||
, _rmPS = [windowLine (V2 (x/2) 0) (V2 (x/2) (y-60))
|
||||
]
|
||||
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
|
||||
}
|
||||
where
|
||||
lnks = map (first toV2)
|
||||
[( (x-20, 0),pi)
|
||||
,( ( 20, 0),pi)
|
||||
,( ( 0, 20),pi/2)
|
||||
]
|
||||
xn = 4
|
||||
yn = 4
|
||||
yd = (y - 40) / fromIntegral yn
|
||||
xd = (x - 40) / fromIntegral xn
|
||||
pth = linksAndPath lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
|
||||
roomC :: RandomGen g => Float -> Float -> State g Room
|
||||
roomC w h = do
|
||||
wl <- takeOne
|
||||
[ sPS (V2 0 0) 0 $ PutWall (rectNSWE (h-60) 0 (w/2-10) (w/2+10)) defaultCrystalWall
|
||||
, windowLine (V2 (w/2) 0) (V2 (w/2) (h-60))
|
||||
]
|
||||
changeLinkFrom fromCond $ roomRectAutoLinks w h
|
||||
& rmPS %~ (wl : )
|
||||
& rmRandPSs .~ [farside]
|
||||
where
|
||||
fromCond (V2 x _,_) = x < w / 2 - 10
|
||||
farside = do
|
||||
x <- state $ randomR (5, w/2 - 20)
|
||||
y <- state $ randomR (5, h - 70)
|
||||
a <- state $ randomR (0, 2*pi)
|
||||
return (V2 x y,a)
|
||||
|
||||
roomPadCut :: [Point2] -> Point2 -> Room
|
||||
roomPadCut ps p = defaultRoom
|
||||
@@ -355,14 +351,9 @@ weaponRoom = join $ takeOne
|
||||
, weaponLongCorridor
|
||||
]
|
||||
|
||||
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 (+.+) [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
|
||||
|
||||
roomCCrits :: RandomGen g => State g Room
|
||||
roomCCrits = roomC 200 200
|
||||
<&> rmPS %~ (replicate 20 (Placement (PSRoomRand 0) randC1 (const Nothing)) ++ )
|
||||
|
||||
longRoom :: RandomGen g => State g Room
|
||||
longRoom = do
|
||||
@@ -410,18 +401,16 @@ shootersRoom' = do
|
||||
x1 <- state $ randomR (20,w/3-20)
|
||||
x2 <- state $ randomR (w/3+20,2*w/3-20)
|
||||
x3 <- state $ randomR (2*w/3+20,w-20)
|
||||
y1 <- state $ randomR (250,550)
|
||||
y2 <- state $ randomR (250,550)
|
||||
y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (250,560)
|
||||
y1 <- state $ randomR (280,550)
|
||||
y2 <- state $ randomR (280,550)
|
||||
y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (280,560)
|
||||
x4 <- state $ randomR (60,w-60)
|
||||
y4 <- state $ randomR (40,180)
|
||||
--p <- takeOne [V2 x1 y1,V2 x2 y2,V2 x3 y3]
|
||||
y4 <- state $ randomR (40,150)
|
||||
let bln x y = putBlockN (x+25) (x-25) (y+20) (y+10)
|
||||
blv x y = putBlockV (x+25) (x-25) (y+20) (y+10)
|
||||
plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
|
||||
++ [spanLightI (V2 0 200) (V2 w 200)
|
||||
, mntLightLnkCond (\(V2 _ y,_) -> y < 50)
|
||||
, mntLightLnkCond (\(V2 _ y,_) -> y > 550)
|
||||
++ [spanLightI (V2 (-10) 200) (V2 (w/2) 200)
|
||||
,spanLightI (V2 (w/2) 200) (V2 (w+10) 200)
|
||||
]
|
||||
toPS x y = return (V2 x y,-0.5*pi)
|
||||
return $ set rmPS plmnts $ roomRectAutoLinks w 600
|
||||
@@ -460,7 +449,10 @@ pillarGrid = do
|
||||
y <- takeOne ys
|
||||
a <- state $ randomR (0,2*pi)
|
||||
return (V2 (x+gap) y,a)
|
||||
let plmnts = replicate 30 (mntLightLnkCond (const True))
|
||||
cornerRestrict (V2 x y,_)
|
||||
= (x > 40 && x < h - 40)
|
||||
|| (y > 40 && y < h - 40)
|
||||
let plmnts = replicate 8 (mntLightLnkCond cornerRestrict)
|
||||
++
|
||||
concat [f x y | x<-xs,y<-ys]
|
||||
return $ roomRect w h (max i 2) (max i 2)
|
||||
@@ -480,31 +472,26 @@ pistolerRoom = pillarGrid
|
||||
shootingRange :: RandomGen g => State g (Tree (Either Room Room))
|
||||
shootingRange = do
|
||||
rm1 <- shootersRoom1 >>= changeLinkTo (\(V2 _ y,_) -> y < 40)
|
||||
>>= filterLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
|
||||
>>= changeLinkFrom (\(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)
|
||||
>>= changeLinkFrom (\(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) (V2 0 20)
|
||||
,Left rm2
|
||||
,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (V2 0 20)
|
||||
]
|
||||
(Right rm3)
|
||||
>>= changeLinkFrom (\(_,r) -> r == 0)
|
||||
return $ treeFromPost
|
||||
[Left rm1
|
||||
,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
|
||||
& rmPS %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
|
||||
,Left rm2
|
||||
,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
|
||||
& rmPS %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
|
||||
]
|
||||
(Right rm3)
|
||||
|
||||
spawnerRoom :: RandomGen g => State g (Tree (Either Room Room))
|
||||
spawnerRoom = do
|
||||
x <- state $ randomR (250,300)
|
||||
y <- state $ randomR (300,400)
|
||||
wl <- takeOne [sPS (V2 0 0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10))
|
||||
defaultCrystalWall
|
||||
,windowLine (V2 (x/2) 0) (V2 (x/2) (y-60))
|
||||
]
|
||||
let plmnts = [sPS (V2 (x/4) ( y/4)) (pi/2) $ PutCrit spawnerCrit
|
||||
,wl
|
||||
,sPS (V2 (x/2) ( y-10)) 0 putLamp
|
||||
]
|
||||
let f (V2 lx _,_) = lx < x/2-5
|
||||
roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (set rmPS plmnts $ roomRect x y 2 2)
|
||||
roomWithSpawner <- roomC x y <&>
|
||||
rmPS %~ (Placement (PSRoomRand 0) (PutCrit spawnerCrit) (const Nothing) :)
|
||||
aRoom <- airlock
|
||||
return $ treeFromTrunk [Left aRoom] roomWithSpawner
|
||||
return $ treeFromTrunk [Left aRoom,Left corridor] $ connectRoom roomWithSpawner
|
||||
|
||||
@@ -18,8 +18,8 @@ import System.Random
|
||||
import Control.Monad.State
|
||||
{- | A passage with a switch that opens forward access while closing backwards access. -}
|
||||
airlock :: RandomGen g => State g Room
|
||||
--airlock = takeOne [airlock0,airlock90,airlockCrystal,airlockZ]
|
||||
airlock = takeOne [airlockZ]
|
||||
airlock = takeOne [airlock0,airlock90,airlockCrystal,airlockZ]
|
||||
--airlock = takeOne [airlockZ]
|
||||
{- | Straight airlock -}
|
||||
airlock0 :: Room
|
||||
airlock0 = defaultRoom
|
||||
|
||||
@@ -51,6 +51,9 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
|
||||
thinHighBar :: Float -> Point2 -> Point2 -> Shape
|
||||
thinHighBar = highBar 3
|
||||
|
||||
thinHighBarChain :: Float -> [Point2] -> Shape
|
||||
thinHighBarChain h = foldMap (uncurry $ thinHighBar h) . loopPairs
|
||||
|
||||
thickHighBar :: Float -> Point2 -> Point2 -> Shape
|
||||
thickHighBar = highBar 5
|
||||
|
||||
|
||||
@@ -71,7 +71,10 @@ roomRectAutoLinks :: Float -> Float -> Room
|
||||
roomRectAutoLinks x y = (roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60))
|
||||
{_rmPS = plmnts}
|
||||
where
|
||||
plmnts = [mntLightLnkCond (const True)]
|
||||
plmnts =
|
||||
[mntLightLnkCond (const True)
|
||||
-- ,sps0 $ PutForeground $ thinHighBarChain 50 $ rectNSWE y 0 0 x
|
||||
]
|
||||
{- Combines two rooms into one room.
|
||||
Mostly involves concatenation. -}
|
||||
combineRooms :: Room -> Room -> Room
|
||||
|
||||
@@ -30,7 +30,8 @@ startRoom = do
|
||||
girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2))
|
||||
treeFromPost [Left rezBox, Left door] . Right
|
||||
<$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0)
|
||||
$ roomRectAutoLinks w h & rmPS .~
|
||||
$ roomRectAutoLinks w h & rmPS %~
|
||||
(
|
||||
[ fground
|
||||
, mountLightJ (V2 0 (h/3)) (V3 40 (h/3) 70)
|
||||
, tankSquareEmboss4 (dim orange) 50 (h-60)
|
||||
@@ -39,5 +40,6 @@ startRoom = do
|
||||
, lightSensor (V2 (0.8*w) (0.25*h)) 0
|
||||
, putLasTurret & placementSpot .~ PS (V2 (0.8*w) (0.8*h)) 0
|
||||
, sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
|
||||
]
|
||||
] ++
|
||||
)
|
||||
)
|
||||
|
||||
@@ -0,0 +1,17 @@
|
||||
module MonadHelp where
|
||||
|
||||
untilJust :: Monad m => m (Maybe a) -> m a
|
||||
untilJust m = go
|
||||
where
|
||||
go = do
|
||||
mayx <- m
|
||||
maybe go return mayx
|
||||
|
||||
untilJustCount :: Monad m => m (Maybe a) -> m (a, Int)
|
||||
untilJustCount m = go 0
|
||||
where
|
||||
go i = do
|
||||
mayx <- m
|
||||
case mayx of
|
||||
Nothing -> go (i+1)
|
||||
Just x -> return (x,i)
|
||||
Reference in New Issue
Block a user