module Deal where
import Data.List

{- 

deal.hs
by Joe Huang (jch2220)

4995 Final Project

Description:
This file handles the card dealing in the free cell. The deal allows 
input number from 1 to 32000 and follows the algorithm developed by 
Jim Horne. 

The algorithm are as followed:

1. Seed the RNG with the number of the deal.
2. Create an array of 52 cards: Ace of Clubs, Ace of Diamonds, Ace of 
    Hearts, Ace of Spades, 2 of Clubs, 2 of Diamonds, and so on through 
    the ranks: Ace, 2, 3, 4, 5, 6, 7, 8, 9, 10, Jack, Queen, King. The
    array indexes are 0 to 51, with Ace of Clubs at 0, and King of 
    Spades at 51.
3. Until the array is empty:
    - Choose a random card at index ≡ next random number (mod array length).
    - Swap this random card with the last card of the array.
    - Remove this random card from the array. (Array length goes down by 1.)
    - Deal this random card.
4. Deal all 52 cards, face up, across 8 columns. The first 8 cards go
    in 8 columns, the next 8 cards go on the first 8 cards, and so on.

Reference:
Deal Cards for FreeCell: https://tfetimes.com/c-deal-cards-for-freecell/

-}

suits :: [String]
suits = ["C","D","H","S"]

ranks :: [String]
ranks = ["A","2","3","4","5","6","7","8","9","T","J","Q","K"]

initialDeck :: [String]
initialDeck = [a++b | a <- ranks, b <- suits]

rng51 :: Int -> [Int] -> [Int]
rng51 seed rngList 
    | length rngList == 51 = reverse $ map (`div` (2 ^ (16::Int))) rngList 
    | otherwise = rng51 rnd (rnd:rngList)
        where rnd = ((214013 * seed + 2531011) `mod` (2 ^ (31::Int))) 

rng51ModLength :: Int -> [Int]
rng51ModLength seed = zipWith (mod) (rng51 seed []) [52,51..0]

findAndReplaceWithLast :: Int -> [String] -> (String, [String])
findAndReplaceWithLast index currentDeck 
    | index >= length currentDeck = error "DealCards: find and replacing index exceed the deck length."
    | otherwise = (head sndDeck, 
                  fstDeck ++ (if length removedDeck > 0 
                              then (last removedDeck):(init removedDeck) 
                                    else []))
        where (fstDeck, sndDeck) = splitAt index currentDeck
              currentCard = head sndDeck
              removedDeck = delete currentCard sndDeck

deal :: [Int] -> [String] -> [String]
deal indexList currentDeck
    | length currentDeck == 1 = [head currentDeck]
    | otherwise = (newDeal):(deal (tail indexList) newDeck)
        where (newDeal, newDeck) = findAndReplaceWithLast (head indexList) currentDeck

startDeal :: Int -> [String]
startDeal i 
    | i < 1 || i > 32000 = error "DealCards: exceed input range [1,32000]."
    | otherwise = deal (rng51ModLength i) initialDeck

separateDealRow :: [String] -> [[String]]
separateDealRow dealedCard = unfoldr (\x -> if null x then Nothing else Just $ splitAt 8 x) dealedCard

showDeal :: [[String]] -> IO ()
showDeal dealedCard = mapM_ print dealedCard

startAndShowDeal :: Int -> IO ()
startAndShowDeal i = showDeal $ separateDealRow $ startDeal i

