Keep track of highest score and congratulate player
This commit is contained in:
		
							parent
							
								
									2891f7883c
								
							
						
					
					
						commit
						99d6a9c56a
					
				
					 2 changed files with 47 additions and 12 deletions
				
			
		
							
								
								
									
										47
									
								
								app/Main.hs
									
										
									
									
									
								
							
							
						
						
									
										47
									
								
								app/Main.hs
									
										
									
									
									
								
							| 
						 | 
					@ -4,20 +4,25 @@ import Control.Monad (when)
 | 
				
			||||||
import Data.Maybe (fromMaybe)
 | 
					import Data.Maybe (fromMaybe)
 | 
				
			||||||
import Data.Monoid ((<>))
 | 
					import Data.Monoid ((<>))
 | 
				
			||||||
import System.Exit (exitSuccess)
 | 
					import System.Exit (exitSuccess)
 | 
				
			||||||
 | 
					import System.IO (readFile, writeFile)
 | 
				
			||||||
 | 
					import Text.Read (readMaybe)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
import Tetris (Game(..))
 | 
					import Tetris (Game(..))
 | 
				
			||||||
import UI.PickLevel (pickLevel)
 | 
					import UI.PickLevel (pickLevel)
 | 
				
			||||||
import UI.Game (playGame)
 | 
					import UI.Game (playGame)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
import Options.Applicative
 | 
					import Options.Applicative
 | 
				
			||||||
 | 
					import qualified System.Directory as D
 | 
				
			||||||
 | 
					import System.FilePath ((</>))
 | 
				
			||||||
 | 
					import qualified System.FilePath as F
 | 
				
			||||||
 | 
					
 | 
				
			||||||
data Opts = Opts
 | 
					data Opts = Opts
 | 
				
			||||||
  { hardDrop :: Maybe HardDropOpt
 | 
					  { hardDrop :: Maybe HardDropOpt
 | 
				
			||||||
  , level    :: Maybe Int
 | 
					  , level    :: Maybe Int
 | 
				
			||||||
  , score    :: Bool
 | 
					  , score    :: Bool
 | 
				
			||||||
  } deriving (Show) -- TODO remove
 | 
					  }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
data HardDropOpt = AsciiOnly | CustomChars String deriving (Show) -- TODO remove
 | 
					data HardDropOpt = AsciiOnly | CustomChars String
 | 
				
			||||||
 | 
					
 | 
				
			||||||
opts :: Parser Opts
 | 
					opts :: Parser Opts
 | 
				
			||||||
opts = Opts
 | 
					opts = Opts
 | 
				
			||||||
| 
						 | 
					@ -31,7 +36,6 @@ opts = Opts
 | 
				
			||||||
    (  long "high-score"
 | 
					    (  long "high-score"
 | 
				
			||||||
    <> help "Print high score and exit" )
 | 
					    <> help "Print high score and exit" )
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					 | 
				
			||||||
hardDropOpt :: Parser HardDropOpt
 | 
					hardDropOpt :: Parser HardDropOpt
 | 
				
			||||||
hardDropOpt = asciiOpt <|> custOpt
 | 
					hardDropOpt = asciiOpt <|> custOpt
 | 
				
			||||||
  where
 | 
					  where
 | 
				
			||||||
| 
						 | 
					@ -65,13 +69,42 @@ main :: IO ()
 | 
				
			||||||
main = do
 | 
					main = do
 | 
				
			||||||
  (Opts hd ml hs) <- execParser fullopts           -- get CLI opts/args
 | 
					  (Opts hd ml hs) <- execParser fullopts           -- get CLI opts/args
 | 
				
			||||||
  let mp = hdOptStr <$> hd                         -- determine hard drop preview cell
 | 
					  let mp = hdOptStr <$> hd                         -- determine hard drop preview cell
 | 
				
			||||||
  when hs (getHighScore >>= print >> exitSuccess) -- show high score and exit
 | 
					  when hs (getHighScore >>= printM >> exitSuccess) -- show high score and exit
 | 
				
			||||||
  l <- fromMaybe pickLevel (return <$> ml)         -- pick level prompt if necessary
 | 
					  l <- fromMaybe pickLevel (return <$> ml)         -- pick level prompt if necessary
 | 
				
			||||||
  g <- playGame l mp                               -- play game
 | 
					  g <- playGame l mp                               -- play game
 | 
				
			||||||
  handleEndGame (_score g)                         -- save & print score
 | 
					  handleEndGame (_score g)                         -- save & print score
 | 
				
			||||||
 | 
					
 | 
				
			||||||
handleEndGame :: Int -> IO ()
 | 
					handleEndGame :: Int -> IO ()
 | 
				
			||||||
handleEndGame = const $ return ()
 | 
					handleEndGame s = do
 | 
				
			||||||
 | 
					  mhs <- getHighScore
 | 
				
			||||||
 | 
					  case mhs of
 | 
				
			||||||
 | 
					    Nothing -> newHighScore
 | 
				
			||||||
 | 
					    Just hs -> if s <= hs then justShowScore else newHighScore
 | 
				
			||||||
 | 
					  where
 | 
				
			||||||
 | 
					    justShowScore = putStrLn $ "Your final score: " ++ show s
 | 
				
			||||||
 | 
					    newHighScore = do
 | 
				
			||||||
 | 
					      putStrLn $ "Congrats! You just got the new highest score: " ++ show s
 | 
				
			||||||
 | 
					      setHighScore s
 | 
				
			||||||
 | 
					
 | 
				
			||||||
getHighScore :: IO Int
 | 
					printM :: Show a => Maybe a -> IO ()
 | 
				
			||||||
getHighScore = error "Not yet implemented"
 | 
					printM Nothing  = putStrLn "None"
 | 
				
			||||||
 | 
					printM (Just s) = print s
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					getHighScore :: IO (Maybe Int)
 | 
				
			||||||
 | 
					getHighScore = do
 | 
				
			||||||
 | 
					  lb <- getLeaderboardFile
 | 
				
			||||||
 | 
					  exists <- D.doesFileExist lb
 | 
				
			||||||
 | 
					  if exists
 | 
				
			||||||
 | 
					     then readMaybe <$> readFile lb
 | 
				
			||||||
 | 
					     else return Nothing
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					setHighScore :: Int -> IO ()
 | 
				
			||||||
 | 
					setHighScore s = do
 | 
				
			||||||
 | 
					  lb <- getLeaderboardFile
 | 
				
			||||||
 | 
					  writeFile lb (show s)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					getLeaderboardFile :: IO FilePath
 | 
				
			||||||
 | 
					getLeaderboardFile = do
 | 
				
			||||||
 | 
					  xdg <- D.getXdgDirectory D.XdgData "tetris"
 | 
				
			||||||
 | 
					  D.createDirectoryIfMissing True xdg
 | 
				
			||||||
 | 
					  return (xdg </> "leaderboard")
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -33,6 +33,8 @@ executable tetris
 | 
				
			||||||
  main-is:             Main.hs
 | 
					  main-is:             Main.hs
 | 
				
			||||||
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
 | 
					  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
 | 
				
			||||||
  build-depends:       base >= 4.7 && < 5
 | 
					  build-depends:       base >= 4.7 && < 5
 | 
				
			||||||
 | 
					                     , directory
 | 
				
			||||||
 | 
					                     , filepath
 | 
				
			||||||
                     , optparse-applicative
 | 
					                     , optparse-applicative
 | 
				
			||||||
                     , tetris
 | 
					                     , tetris
 | 
				
			||||||
  default-language:    Haskell2010
 | 
					  default-language:    Haskell2010
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue