Skip to content
Snippets Groups Projects
Commit a72df803 authored by Janne Sirviö's avatar Janne Sirviö :hushed:
Browse files

Not ready

parent 0f0f6b05
No related branches found
No related tags found
No related merge requests found
.stack-work/
*~
twenty-one.cabal
module Main where
import Control.Monad
import Card
import Lib
import System.Random
main :: IO ()
main = do
putStrLn "How many random integer numbers should we generate?"
count <- read <$> getLine :: IO Int
putStrLn "\n\nWelcome to play Twenty-One game!"
putStrLn "\nLet's start....\n"
putStrLn $ take 100 (repeat '-')
putStrLn "What would be the minimum value of those numbers?"
min <- read <$> getLine :: IO Int
-- Generate random numbers
g <- getStdGen
let listOfNums = take 10 (randomRs (0, 51) g :: [Int])
putStrLn "What would be the maximum value of those numbers?"
max <- read <$> getLine :: IO Int
let num = (listOfNums!!0)
if count <= 0 then error "The count must be a positive number"
else if max < min then error "The minimum cannot be larger than the maximum"
else putStrLn $ "Very well, producing " ++
(if count == 1 then "a number" else show count ++ " numbers") ++
" between " ++ show min ++ " and " ++ show max ++ "!"
tellCard num
putStrLn $ "In real life, we could emulate that with " ++
show count ++ " x " ++
show (max-min+1) ++ " sided dice rolls."
--let value = getValue $ showCard (pullCardFromDeck deck num)
forM_ [1..count] (generateNumber min max)
--putStrLn $ "You have now" ++ show value ++ "/21"
putStrLn "Do you want another card? (y/n)"
wantsCard <- getChar
if wantsCard == 'y' then tellCard (listOfNums!!1)
else simulateComputer
putStrLn "Game over!"
askForCard :: IO ()
askForCard = do
putStrLn "Do you want another card? (y/n)"
wantsCard <- getChar
if wantsCard == 'y' then askForCard
else simulateComputer
tellCard :: Int -> IO ()
tellCard a = do
let card = showCard (pullCardFromDeck deck a)
putStrLn $ "You got a card: " ++ card ++ "\n"
simulateComputer :: IO ()
simulateComputer = do
putStrLn "Player stays."
putStrLn $ take 100 (repeat '-')
putStrLn "Computer's turn:"
\ No newline at end of file
......@@ -22,8 +22,6 @@ description: Please see the README on GitHub at <https://github.com/gith
dependencies:
- base >= 4.7 && < 5
- random >= 1.1
- containers
- array
library:
source-dirs: src
......@@ -38,7 +36,6 @@ executables:
- -with-rtsopts=-N
dependencies:
- twenty-one
- transformers
tests:
twenty-one-test:
......
......@@ -2,6 +2,10 @@ module Card
( Suit (..)
, Value (..)
, Card (..)
,showCard
,deck
,pullCardFromDeck
,getValue
) where
data Suit = Spades | Diamonds | Clubs | Hearts
......@@ -12,7 +16,7 @@ data Value = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack
data Card = Card { _suit :: Suit
,_value :: Value
} deriving (Eq, Show)
} deriving (Eq, Show, Bounded)
type Deck = [Card]
......@@ -30,3 +34,6 @@ showCard (Card {_suit = s, _value = v}) = show v ++ " of " ++ show s
pullCardFromDeck :: Deck -> Int -> Card
pullCardFromDeck deck num = deck!!num
getValue :: Card -> Value
getValue (Card {_suit = s, _value = v}) = v
\ No newline at end of file
......@@ -3,9 +3,6 @@ module Lib
) where
import System.Random
import Data.Map
import Data.Array.IO
import Control.Monad
generateNumber:: Int -> Int -> Int -> IO ()
generateNumber min max n = do
......@@ -14,19 +11,6 @@ generateNumber min max n = do
-- | Randomly shuffle a list
-- /O(N)/
shuffle :: [a] -> IO [a]
shuffle xs = do
ar <- newArray n xs
forM [1..n] $ \i -> do
j <- randomRIO (i,n)
vi <- readArray ar i
vj <- readArray ar j
writeArray ar j vi
return vj
where
n = length xs
newArray :: Int -> [a] -> IO (IOArray Int a)
newArray n xs = newListArray (1,n) xs
--getRandomNums :: Int -> [Int]
--getRandomNums = randomRs (2,52) g
--where let g = mkStdGen 10
\ No newline at end of file
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment