Build is fixed, build of tests is not fixed

app/labyrinth/src/Labyrinth/Algorithms.hs

@@ -1,6 +1,6 @@
 {-|
 Functions used for assessment of cell space occupation or
-player options with regard to cell space limitations.  
+player options with regard to cell space limitations.
 -}
 
 
@@ -13,7 +13,15 @@ import Labyrinth.Prelude
 import Labyrinth.Domain
 
 emptyLabyrinthInfo :: LabyrinthInfo
-emptyLabyrinthInfo = LabyrinthInfo (0, 0) Map.empty Set.empty Nothing Nothing
+-- emptyLabyrinthInfo = LabyrinthInfo (0, 0) Map.empty Set.empty Nothing Nothing Map.empty
+emptyLabyrinthInfo = LabyrinthInfo
+  { liBounds      = (0, 0)
+  , liWormholes   = Map.empty
+  , liExits       = Set.empty
+  , liTreasure    = Nothing
+  , liTheMap      = Nothing
+  , liTrailpoints = Map.empty
+  }
 
 calcNextPos :: Pos -> Direction -> Pos
 calcNextPos (x, y) DirUp    = (x, y - 1)
@@ -43,9 +51,12 @@ analyzeLabyrinth lab = Map.foldrWithKey f emptyLabyrinthInfo lab
 
 analyzeContent :: Pos -> Content -> LabyrinthInfo -> LabyrinthInfo
 analyzeContent p (Wormhole n) labInfo
-  = labInfo { liWormholes = Map.insert n p $ liWormholes labInfo }
-  analyzeContent p (Trailpoint n) labInfo
-    = labInfo { liTrailpoints = Map.insert n p $ liTrailpoints labInfo }
+    = labInfo { liWormholes = Map.insert n p $ liWormholes labInfo }
+analyzeContent p (Trailpoint n) labInfo
+    = let
+        curTrailpoints = liTrailpoints labInfo
+        newTrailpoints = Map.insert n p curTrailpoints
+      in labInfo { liTrailpoints = newTrailpoints }
 analyzeContent p Treasure labInfo = labInfo { liTreasure = Just p }
 analyzeContent p TheMap labInfo = labInfo { liTheMap = Just p }
 analyzeContent _ _ labInfo = labInfo

app/labyrinth/src/Labyrinth/App.hs

@@ -18,6 +18,7 @@ import Labyrinth.Render
 import Labyrinth.Algorithms
 import Labyrinth.Gen
 import Labyrinth.Lens
+import Labyrinth.Labyrinths
 import qualified Labyrinth.KVDB.Model as KVDB
 import qualified Labyrinth.KVDB.Repository as KVDB
 
@@ -95,7 +96,8 @@ setPlayerPos st newPos = writeVarIO (st ^. playerPos) newPos
 
 updateTrail :: AppState -> (Int, Int) -> LangL ()
 updateTrail st newPos = do
-  trailList <- List.insert getPlayerPos newPos : updateTrail st playerPos
+--  trailList <- List.insert getPlayerPos newPos : updateTrail st playerPos
+  error "Not implemented yet."
 
 
 getPlayerThreasureState :: AppState -> LangL Bool
@@ -153,21 +155,26 @@ performPlayerContentEvent st = do
   performPlayerContentEvent' st pos content
 
 performPlayerContentEvent' :: AppState -> Pos -> Content -> LangL ()
+
 performPlayerContentEvent' _ _ NoContent = pure ()
+
 performPlayerContentEvent' st pos Treasure = do
   addGameMessage st "You found a treasure!"
   writeVarIO (st ^. playerInventory . treasureState) True
   setCellContent st pos NoContent
+
 performPlayerContentEvent' st _ (Wormhole n) = do
   addGameMessage st $ "You found a wormhole. You have been moved to the next wormhole."
   executeWormhole st n
+
 performPlayerContentEvent' st pos TheMap = do
   addGameMessage st "You found the map!"
-  writeVarIO (st ^. playerInventory . the_mapState) True
+  writeVarIO (st ^. playerInventory . theMapState) True
   setCellContent st pos NoContent
-performPlayerContentEvent' st _ (Trailpoint n) = do
+
+performPlayerContentEvent' st pos (Trailpoint n) = do
   addGameMessage st $ "You added a point to your trail."
-  updateTrail st n
+  updateTrail st pos
 
 addGameMessage :: AppState -> String -> LangL ()
 addGameMessage st msg = do
@@ -187,7 +194,7 @@ makePlayerMove st dir = do
     LeavingLabyrinthMove   -> setGameState st PlayerIsAboutLeaving
     SuccessfullMove newPos -> do
       addGameMessage st "Step executed."
-      updateTrail st pos
+      updateTrail st newPos  -- ?? newPos or plPos
       setPlayerPos st newPos
       performPlayerContentEvent st
 
@@ -226,9 +233,11 @@ printLab st = do
 
   printLabRender' $ renderLabyrinth' template lab plPos brPos
 
+
+-- | Print a map. For now using testTrail which is a temporary data
 printTheMap :: AppState -> LangL ()
-printTheMap = do
-  template   <- readVarIO $ st ^. labRenderTemplate
+printTheMap st = do
+  template <- readVarIO $ st ^. labRenderTemplate
   printLabRender' $ renderLabyrinth' template testTrail (0, 0) (0, 0)
 
 moveBear :: AppState -> LangL ()
@@ -290,10 +299,10 @@ saveGame st idx = do
   plPos <- readVarIO $ st ^. playerPos
   plHP  <- readVarIO $ st ^. playerHP
   tr    <- readVarIO $ st ^. playerInventory . treasureState
-  mp    <- readVarIO $ st ^. playerInventory . the_mapState
+  mp    <- readVarIO $ st ^. playerInventory . theMapState
   brPos <- readVarIO $ st ^. bearPos
 
-  let plInv = Inventory tr
+  let plInv = Inventory tr mp
 
   eRes <- KVDB.saveGameState (st ^. kvdbConfig)
     $ KVDB.GameEntity idx lab plPos plHP plInv brPos
@@ -318,7 +327,7 @@ loadGame st idx = do
       writeVarIO (st ^. playerPos) gePlayerPos
       writeVarIO (st ^. playerHP) gePlayerHP
       writeVarIO (st ^. playerInventory . treasureState) $ treasureFound gePlayerInventory
-      writeVarIO (st ^. playerInventory . the_mapState) $ the_mapFound gePlayerInventory
+      writeVarIO (st ^. playerInventory . theMapState) $ the_mapFound gePlayerInventory
       writeVarIO (st ^. bearPos) geBearPos
       writeVarIO (st ^. gameState) PlayerMove
       pure "Game successfully loaded from KV DB."
@@ -349,7 +358,7 @@ startGame' st lab = do
   writeVarIO (st ^. playerHP) 100
   writeVarIO (st ^. bearPos) (bearX, bearY)
   writeVarIO (st ^. playerInventory . treasureState) False
-  writeVarIO (st ^. playerInventory . the_mapState) False
+  writeVarIO (st ^. playerInventory . theMapState) False
   writeVarIO (st ^. gameState) PlayerMove
 
   pure "New game started."
@@ -410,6 +419,7 @@ help = do
 
 initAppState
   :: PlayerHasTreasure
+  -> Bool
   -> PlayerPos
   -> PlayerHP
   -> BearPos
@@ -417,37 +427,51 @@ initAppState
   -> GameState
   -> KVDBConfig KVDB.LabKVDB
   -> AppL AppState
-initAppState tr plPos plHP brPos lab gst kvdbCfg = do
-  let LabyrinthInfo {liBounds, liWormholes} = analyzeLabyrinth lab
-  let renderTemplate = renderSkeleton liBounds
+initAppState playeHasTreasure playerHasMap plPos plHP brPos lab gst kvdbCfg = do
+  let labInfo        = analyzeLabyrinth lab
+  let renderTemplate = renderSkeleton (liBounds labInfo)
 
   renderTemplateVar <- newVarIO renderTemplate
   renderVar         <- newVarIO renderTemplate
   labVar            <- newVarIO lab
-  labBoundsVar      <- newVarIO liBounds
-  wormholesVar      <- newVarIO liWormholes
-  trailpointsVar    <- newVarIO liTrailpoints
+  labBoundsVar      <- newVarIO (liBounds labInfo)
+  wormholesVar      <- newVarIO (liWormholes labInfo)
+  trailpointsVar    <- newVarIO Map.empty
+  trailPointVar     <- newVarIO 0
   posVar            <- newVarIO plPos
   playerHPVar       <- newVarIO plHP
   bearPosVar        <- newVarIO brPos
-  inv               <- InventoryState <$> newVarIO tr
+
+  -- inv               <- InventoryState <$> newVarIO playeHasTreasure <*> newVarIO playerHasMap
+
+  -- inv               <- do
+  --   var1 <- newVarIO playeHasTreasure
+  --   var2 <- newVarIO playerHasMap
+  --   pure (InventoryState var1 var2)
+
+  var1 <- newVarIO playeHasTreasure
+  var2 <- newVarIO playerHasMap
+  let inventory = InventoryState var1 var2
+
   gameStateVar      <- newVarIO gst
   moveMsgsVar       <- newVarIO []
 
   pure $ AppState
-    labVar
-    labBoundsVar
-    renderTemplateVar
-    renderVar
-    wormholesVar
-    trailpointsVar
-    posVar
-    playerHPVar
-    bearPosVar
-    inv
-    gameStateVar
-    moveMsgsVar
-    kvdbCfg
+    { _labyrinth            = labVar
+    , _labBounds            = labBoundsVar
+    , _labRenderTemplate    = renderTemplateVar
+    , _labRenderVar         = renderVar
+    , _labWormholes         = wormholesVar
+    , _labTrailpoints       = trailpointsVar
+    , _labCurrentTrailPoint = trailPointVar
+    , _playerPos            = posVar
+    , _playerHP             = playerHPVar
+    , _bearPos              = bearPosVar
+    , _playerInventory      = inventory
+    , _gameState            = gameStateVar
+    , _gameMessages         = moveMsgsVar
+    , _kvdbConfig           = kvdbCfg
+    }
 
 labyrinthApp :: AppState -> AppL ()
 labyrinthApp st = do

app/labyrinth/src/Labyrinth/Domain.hs

@@ -54,10 +54,10 @@ data Inventory = Inventory
   deriving (Show, Read, Eq, Ord, Generic, ToJSON, FromJSON)
 
 data LabyrinthInfo = LabyrinthInfo
-  { liBounds    :: Bounds
-  , liWormholes :: Wormholes
-  , liExits     :: Exits
-  , liTreasure  :: Maybe Pos
-  , liTheMap    :: Maybe Pos
-  , liTrailpoints :: Trailpoints
+  { liBounds      :: Bounds
+  , liWormholes   :: Wormholes
+  , liExits       :: Exits
+  , liTreasure    :: Maybe Pos
+  , liTheMap      :: Maybe Pos
+  , liTrailpoints :: Map Int Pos
   }

app/labyrinth/src/Labyrinth/Lens.hs

@@ -15,3 +15,14 @@ import           Labyrinth.Types (InventoryState, AppState)
 
 makeFieldsNoPrefix ''AppState
 makeFieldsNoPrefix ''InventoryState
+
+
+-- uses _playerInventory
+-- playerInventory :: Lens AppState InventoryState
+-- playerInventory = ...
+
+
+
+-- uses _theMapState
+-- theMapState :: Lens InventoryState (StateVar PlayerHasTheMap)
+-- theMapState = ...

app/labyrinth/src/Labyrinth/Render.hs

@@ -55,8 +55,8 @@ mergeCellContent content Nothing = "!" <> show content
 mergeCellContent NoContent _ = fullSpace
 mergeCellContent Treasure _ = "T   "
 mergeCellContent TheMap _ = "M   "
-mergeCellContent (Trailpoint n) _ | n = " " <> show n <> "* "
-mergeCellContent (Wormhole n) _ | n < 10 = "  W" <> show n
+mergeCellContent (Trailpoint n) _ = " " <> show n <> "* "
+mergeCellContent (Wormhole n) _ | n < 10  = "  W" <> show n
 mergeCellContent (Wormhole n) _ | n >= 10 = "  W?"
 mergeCellContent content renderedContent = error $ "mergeCellContent: unexpected arguments: " <> show content <> ", " <> show renderedContent
 
@@ -190,10 +190,10 @@ renderLabyrinth lab plPos bearPos = renderLabyrinth' skeleton lab plPos bearPos
     LabyrinthInfo {liBounds} = analyzeLabyrinth lab
     skeleton = renderSkeleton liBounds
 
-renderTheLabMap :: Labyrinth -> Pos -> LabRender
-renderTheLabMap lab plPos plTrail =
-  renderPlayer plPos
-    $ renderTrail trailMap
+-- renderTheLabMap :: Labyrinth -> Pos -> LabRender
+-- renderTheLabMap lab plPos plTrail =
+--   renderPlayer plPos
+--     $ renderTrail trailMap
 
 printLabRender' :: LabRender -> LangL ()
 printLabRender' ((rendMaxX, rendMaxY), labRender) = do

app/labyrinth/src/Labyrinth/Types.hs

@@ -20,7 +20,7 @@ type PlayerHasTheMap = Bool
 
 data InventoryState = InventoryState
   { _treasureState :: StateVar PlayerHasTreasure
-    _theMapState   :: StateVar PlayerHasTheMap
+  , _theMapState   :: StateVar PlayerHasTheMap
   }
 
 data GameState

app/labyrinth/src/Main.hs

@@ -23,7 +23,7 @@ loggerCfg = D.LoggerConfig
 
 startApp :: AppL ()
 startApp = do
-  st <- Lab.initAppState False (0,0) 100 (0,0) Lab.testLabyrinth2 Lab.GameStart kvdbConfig
+  st <- Lab.initAppState False False (0,0) 100 (0,0) Lab.testLabyrinth2 Lab.GameStart kvdbConfig
   Lab.labyrinthApp st
 
 main :: IO ()