Merge branch 'master' of github.com:norm2782/HaskBan

Conflicts: HaskBan.hs HaskBan/Monad.hs
norm2782 · Aug 26, 2010 · b27b44e · b27b44e
2 parents cbedbaa + 1d19431
commit b27b44e
Show file tree

Hide file tree

Showing 4 changed files with 27 additions and 16 deletions.
diff --git a/HaskBan.hs b/HaskBan.hs
@@ -23,8 +23,8 @@ module HaskBan (main) where
   main :: SokobanMonad ()
   main = do
     window <- liftIO setupHaskBanGUI
+    liftIO $ showMoves window 0
     liftIO refresh
-    liftIO $ showMoves 0
     loopUntil (readKeyAndPrint window)
     liftIO $ endWin
 
@@ -42,19 +42,16 @@ module HaskBan (main) where
         liftIO endWin
         return True
       else do
+        incrNumberOfSteps
+        steps <- getNumberOfSteps
+        liftIO $ showMoves window steps
         isFinished <- keyPressed key
-        --bs <- sort `liftM` getBoxesPositions
-        --ts <- sort `liftM` getTargetPositions
-        --liftIO $ mvWAddStr window 19 0 (show $ length bs)
-        --liftIO $ mvWAddStr window 20 0 (show bs)
-        --liftIO $ mvWAddStr window 21 0 (show $ length ts)
-        --liftIO $ mvWAddStr window 22 0 (show ts)
         when isFinished (liftIO (wclear window >> printYouWonScreen window))
         liftIO $ refresh
         return isFinished
 
-  showMoves :: Int -> IO ()
-  showMoves s = mvWAddStr stdScr 3 30 ("Number of moves: " ++ show s)
+  showMoves :: Window -> Int -> IO ()
+  showMoves w s = mvWAddStr w 3 30 ("Number of key-presses: " ++ show s)
 
   -- keyPressed :: (MonadState SokobanInfo) m => Key -> m ()
   keyPressed :: Key -> SokobanMonad Bool
@@ -67,7 +64,7 @@ module HaskBan (main) where
                      | key == KeyDown  || key == (KeyChar 'j') = translateDown
                      | key == KeyLeft  || key == (KeyChar 'h') = translateLeft
                      | key == KeyRight || key == (KeyChar 'l') = translateRight
-                     | otherwise                               = (\(x, y) -> (x, y))
+                     | otherwise                               = id 
 
   shouldTerminate :: Key -> Bool
   shouldTerminate (KeyChar '\ESC') = True

diff --git a/HaskBan/Monad.hs b/HaskBan/Monad.hs
@@ -45,6 +45,15 @@ module HaskBan.Monad where
   getTargetPositions :: (MonadState SokobanInfo) m => m [Point]
   getTargetPositions = targets `liftM` get
 
+  getNumberOfSteps :: (MonadState SokobanInfo) m => m Int
+  getNumberOfSteps = numSteps `liftM` get
+
+  putNumberOfSteps :: (MonadState SokobanInfo) m => Int -> m ()
+  putNumberOfSteps steps = get >>= \state -> put (state { numSteps = steps })
+
+  incrNumberOfSteps :: (MonadState SokobanInfo) m => m ()
+  incrNumberOfSteps = getNumberOfSteps >>= putNumberOfSteps . (+1)
+
   getBoxesPositions :: (MonadState SokobanInfo) m => m [Point]
   getBoxesPositions = boxes `liftM` get
 
@@ -101,6 +110,11 @@ module HaskBan.Monad where
     ppos <- getPlayerPosition
     let ppos' = trans ppos
     when (canMoveTo sm ppos' trans) $ do
+<<<<<<< HEAD
+=======
+      incrNumberOfSteps
+      -- liftIO $ putStrLn "Hey Joe Joe Joe" 
+>>>>>>> 1d1943111d993e95612b3a76d0e5b17591de7e28
       when (isBox ppos' sm) $ do
         moveBox ppos' trans
       -- we have updated the SokobanInfo

diff --git a/HaskBan/Parser.hs b/HaskBan/Parser.hs
@@ -67,8 +67,7 @@ module HaskBan.Parser (parseSokoMaps,
           b@(Target Box)  -> ((point:bs), (point:ts), player)
           t@(Target HBT.Empty) -> (bs, (point:ts), player)
           _ -> st
-      sokobanInfo = SokobanInfo 0  p bs ts sokoMap
-
+      sokobanInfo = SokobanInfo 0 0 p bs ts sokoMap
 
   -- | Main Method
   parseSokoMaps :: ByteString -> SokoMaps

diff --git a/HaskBan/Types.hs b/HaskBan/Types.hs
@@ -31,11 +31,12 @@ module HaskBan.Types where
   type SokoMaps    = IntMap SokoMap
 
   data SokobanInfo = SokobanInfo {
+    numSteps     :: Int,
     currentLevel :: Int,
-    player  :: Point,
-    boxes   :: [Point],
-    targets :: [Point],
-    sokoMap :: SokoMap
+    player       :: Point,
+    boxes        :: [Point],
+    targets      :: [Point],
+    sokoMap      :: SokoMap
   } deriving (Show)