labyrinth 0.4.2.0 → 0.5.0.0

raw patch · 3 files changed

+35/−11 lines, 3 files

Files

• labyrinth.cabal +1/−1
• src/Labyrinth/Generate.hs +7/−6
• src/Labyrinth/Map.hs +27/−4

@@ -1,5 +1,5 @@ name:                labyrinth-version:             0.4.2.0+version:             0.5.0.0 synopsis:            A complicated turn-based game description:         Players take turns in a labyrinth, competing with each                      other to pick a treasure and carry it out. They only know

@@ -15,8 +15,9 @@ import Data.Maybe import Data.Tuple -generateLabyrinth :: RandomGen g => Int -> Int -> Int -> g -> (Labyrinth, g)-generateLabyrinth w h p = runRand $ execStateT generate $ emptyLabyrinth w h p+generateLabyrinth :: RandomGen g => LabyrinthParams -> g -> (Labyrinth, g)+generateLabyrinth p = runRand $ execStateT (generate f) $ emptyLabyrinth p+    where f = p ^. lpfeatures  type LabGen g a = LabState (Rand g) a @@ -238,15 +239,15 @@             put v             untilRN (n - 1) prop act -generate :: RandomGen g => LabGen g ()-generate = do+generate :: RandomGen g => LabyrinthFeatures -> LabGen g ()+generate f = do     untilRN 10 goodDistribution $ do         res <- untilRN 10 goodReachability $ do             putArmories             putHospitals-            putPits+            when (f ^. lfpits) $ putPits             untilRN 50 goodReachability $ do-                putRivers+                when (f ^. lfrivers) putRivers                 putWalls         if res             then do

@@ -119,6 +119,26 @@  makeLenses ''Labyrinth +data LabyrinthFeatures = LabyrinthFeatures { _lfpits :: Bool+                                           , _lfrivers :: Bool+                                           }++makeLenses ''LabyrinthFeatures++defaultFeatures :: LabyrinthFeatures+defaultFeatures = LabyrinthFeatures True True++simpleFeatures :: LabyrinthFeatures+simpleFeatures = LabyrinthFeatures False False++data LabyrinthParams = LabyrinthParams { _lpfeatures :: LabyrinthFeatures+                                       , _lpwidth  :: Int+                                       , _lpheight :: Int+                                       , _lpplayers :: Int+                                       }++makeLenses ''LabyrinthParams+ isInside :: Position -> Labyrinth -> Bool isInside (Pos x y) l = and [ x >= 0                            , x < w@@ -158,14 +178,17 @@ mapRectangle :: a -> Int -> Int -> M.Map Position a mapRectangle x w h = M.fromList $ zip (posRectangle w h) (repeat x) -emptyLabyrinth :: Int -> Int -> Int -> Labyrinth-emptyLabyrinth w h playerCount =-    let initialLab = Labyrinth { _labWidth           = w+emptyLabyrinth :: LabyrinthParams -> Labyrinth+emptyLabyrinth p =+    let w = p ^. lpwidth+        h = p ^. lpheight+        pc = p ^. lpplayers+        initialLab = Labyrinth { _labWidth           = w                                , _labHeight          = h                                , _cells              = mapRectangle (emptyCell Land) w h                                , _wallsH             = mapRectangle NoWall w (h + 1)                                , _wallsV             = mapRectangle NoWall (w + 1) h-                               , _players            = replicate playerCount $ initialPlayer $ Pos 0 0+                               , _players            = replicate pc $ initialPlayer $ Pos 0 0                                , _currentTurn        = 0                                , _positionsChosen    = False                                , _gameEnded          = False