diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..31ab9cc --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*.hi +*.o +*.swp diff --git a/Config.hs b/Config.hs index 221bc67..ad8be6c 100644 --- a/Config.hs +++ b/Config.hs @@ -1,5 +1,10 @@ module Config where +import System.Random +import State +import Timestamp +import Packs + genesis :: Timestamp genesis = Ts 29 09 1996 @@ -13,14 +18,14 @@ initialRotation :: State initialRotation = ((i, o), b, r) where i = createInRot [ - lunar1, lunar2, lunar3, lunar4, lunar5, lunar6 - , sansan1 , sansan2 , sansan3 , sansan4 , sansan5 , sansan6 - , mumbad1 , mumbad2 , mumbad3 , mumbad4 , mumbad5 , mumbad6 + Lunar1, Lunar2, Lunar3, Lunar4, Lunar5, Lunar6 + , Sansan1 , Sansan2 , Sansan3 , Sansan4 , Sansan5 , Sansan6 + , Mumbad1 , Mumbad2 , Mumbad3 , Mumbad4 , Mumbad5 , Mumbad6 ] o = createOutRot [ - flash1 , flash2 , flash3 , flash4 , flash5 , flash6 - , red1 , red2 , red3 , red4 , red5 , red6 - , kitara1 , kitara2 , kitara3 , kitara4 , kitara5 , kitara6 + Flash1 , Flash2 , Flash3 , Flash4 , Flash5 , Flash6 + , Red1 , Red2 , Red3 , Red4 , Red5 , Red6 + , Kitara1 , Kitara2 , Kitara3 , Kitara4 , Kitara5 , Kitara6 ] - b = Bq [Just rr, Just td, Just dd, Just oc, Just hp, Just cc, Nothing] + b = Bq [Just Cc, Just Hp, Just Oc, Just Dd, Just Td, Just Rr, Nothing] r = entropy diff --git a/Format.hs b/Format.hs index 0181f7d..52592df 100644 --- a/Format.hs +++ b/Format.hs @@ -1,17 +1,27 @@ module Format where +import System.Random +import State +import Timestamp +import Config + +currentFormat :: Timestamp -> State +currentFormat t = strictApplyN n nextFormat initialRotation + where + n = t `monthsSince` genesis + nextFormat :: State -> State nextFormat (p, b, r) = (np, nb, nr) where ip = rotateOld p - (np, nr) = addNewPack . addNewPack (ip, r) + (np, nr) = (addNewPack . addNewPack) (ip, r) nb = rotateBox b legalOutRot :: [OutRot] -> [OutRot] legalOutRot x = filter (\(Or _ n) -> n == 0) x updatePackAge :: [OutRot] -> [OutRot] -updatePackAge p = map (\(Or s n) -> (Or s $ max 0 (n-1)) p +updatePackAge p = map (\(Or s n) -> (Or s $ max 0 (n-1))) p setIllegal :: InRot -> OutRot setIllegal (Ir n) = Or n 3 @@ -23,7 +33,7 @@ rotateOld :: Pool -> Pool rotateOld (i, o) = (ni, no) where ni = drop 2 i - no = o ++ dropped + no = (updatePackAge o) ++ dropped dropped = map setIllegal (take 2 i) addNewPack :: (Pool, StdGen) -> (Pool, StdGen) @@ -32,12 +42,13 @@ addNewPack ((i, o), r) = ((ni, no), nr) lp = length $ legalOutRot o (ip, nr) = randomR (0, lp-1) r np = (legalOutRot o) !! ip - ni = i ++ (setLegal np) + ni = i ++ [(setLegal np)] no = filter (\x -> x /= np) o rotate :: Integer -> [a] -> [a] -rotate _ [] = [] -rotate n xs = zipWith const (drop (fromIntegral n) (cycle xs)) xs +rotate n xs = take lxs . drop ((fromIntegral n) `mod` lxs) . cycle $ xs + where + lxs = length xs rotateBox :: BoxQueue -> BoxQueue rotateBox (Bq x) = Bq $ rotate 1 x diff --git a/Main b/Main new file mode 100755 index 0000000..f2b0f65 Binary files /dev/null and b/Main differ diff --git a/Main.hs b/Main.hs index 21a8d7b..f57bfca 100644 --- a/Main.hs +++ b/Main.hs @@ -1,19 +1,26 @@ module Main where -import System.Random -import Data.List -import Data.Maybe import Data.Time.Clock import Data.Time.Calendar +import Data.Maybe import Packs import State - - +import Format +import Timestamp main :: IO () main = do t <- getCurrentTime >>= return . toGregorian . utctDay - let ts = toTS t - let state = getCurrentRotation ts - let out = (printLegal state) ++ [""] ++ (printPreview $ getPreview ts state) - mapM_ putStrLn $ out + mapM_ putStrLn $ showState (currentFormat $ toTS t) + +toTS :: (Integer, Int, Int) -> Timestamp +toTS (y,m,d) = Ts (fromIntegral d) (fromIntegral m) y + +showState :: State -> [String] +showState ((i, o), (Bq b), _) = + [ + "Legal Packs:\n" ++ concat (map (\(Ir n) -> " " ++ show n ++ "\n") i) + , "Legal Boxes:\n" ++ concat (map (\x -> " " ++ show x ++ "\n") (catMaybes $ tail b)) + , "Rotated Packs:\n" ++ concat (map (\(Or n _) -> " " ++ show n ++ "\n") o) + , "Rotated Boxes:\n" ++ concat (map (\x -> " " ++ show x ++ "\n") (catMaybes $ [head b])) + ] diff --git a/Packs.hs b/Packs.hs index 669abe9..356ad2e 100644 --- a/Packs.hs +++ b/Packs.hs @@ -1,58 +1,58 @@ module Packs where data BigBox = - cc | hp | oc | dd | td | rr + Cc | Hp | Oc | Dd | Td | Rr deriving Eq instance Show BigBox where - Show cc = "Creation and Control" - Show hp = "Honor and Profit" - Show oc = "Order and Chaos" - Show dd = "Data and Destiny" - Show td = "Terminal Directive" - Show rr = "Reign and Reverie" + show Cc = "Creation and Control" + show Hp = "Honor and Profit" + show Oc = "Order and Chaos" + show Dd = "Data and Destiny" + show Td = "Terminal Directive" + show Rr = "Reign and Reverie" data DataPack = - lunar1 | lunar2 | lunar3 | lunar4 | lunar5 | lunar6 - | sansan1 | sansan2 | sansan3 | sansan4 | sansan5 | sansan6 - | mumbad1 | mumbad2 | mumbad3 | mumbad4 | mumbad5 | mumbad6 - | flash1 | flash2 | flash3 | flash4 | flash5 | flash6 - | red1 | red2 | red3 | red4 | red5 | red6 - | kitara1 | kitara2 | kitara3 | kitara4 | kitara5 | kitara6 + Lunar1 | Lunar2 | Lunar3 | Lunar4 | Lunar5 | Lunar6 + | Sansan1 | Sansan2 | Sansan3 | Sansan4 | Sansan5 | Sansan6 + | Mumbad1 | Mumbad2 | Mumbad3 | Mumbad4 | Mumbad5 | Mumbad6 + | Flash1 | Flash2 | Flash3 | Flash4 | Flash5 | Flash6 + | Red1 | Red2 | Red3 | Red4 | Red5 | Red6 + | Kitara1 | Kitara2 | Kitara3 | Kitara4 | Kitara5 | Kitara6 deriving Eq instance Show DataPack where - Show lunar1 = "Upstalk" - Show lunar2 = "The Spaces Between" - Show lunar3 = "First Contact" - Show lunar4 = "Up and Over" - Show lunar5 = "All That Remains" - Show lunar6 = "The Source" - Show sansan1 = "The Valley" - Show sansan2 = "Breaker Bay" - Show sansan3 = "Chrome City" - Show sansan4 = "The Underway" - Show sansan5 = "Old Hollywood" - Show sansan6 = "The Universe of Tomorrow" - Show mumbad1 = "Kala Ghoda" - Show mumbad2 = "Business First" - Show mumbad3 = "Democracy and Dogma" - Show mumbad4 = "Salsette Island" - Show mumbad5 = "The Liberated Mind" - Show mumbad6 = "Fear the Masses" - Show flash1 = "23 Seconds" - Show flash2 = "Blood Money" - Show flash3 = "Escalation" - Show flash4 = "Intervention" - Show flash5 = "Martial Law" - Show flash6 = "Quorum" - Show red1 = "Daedalus Complex" - Show red2 = "Station One" - Show red3 = "Earth's Scion" - Show red4 = "Blood and Water" - Show red5 = "Free Mars" - Show red6 = "Crimson Dust" - Show kitara1 = "Sovereign Sight" - Show kitara2 = "Down the White Nile" - Show kitara3 = "Council of the Crest" - Show kitara4 = "The Devil and the Dragon" - Show kitara5 = "Whispers in Nalubaale" - Show kitara6 = "Kampala Ascendent" + show Lunar1 = "Upstalk" + show Lunar2 = "The Spaces Between" + show Lunar3 = "First Contact" + show Lunar4 = "Up and Over" + show Lunar5 = "All That Remains" + show Lunar6 = "The Source" + show Sansan1 = "The Valley" + show Sansan2 = "Breaker Bay" + show Sansan3 = "Chrome City" + show Sansan4 = "The Underway" + show Sansan5 = "Old Hollywood" + show Sansan6 = "The Universe of Tomorrow" + show Mumbad1 = "Kala Ghoda" + show Mumbad2 = "Business First" + show Mumbad3 = "Democracy and Dogma" + show Mumbad4 = "Salsette Island" + show Mumbad5 = "The Liberated Mind" + show Mumbad6 = "Fear the Masses" + show Flash1 = "23 Seconds" + show Flash2 = "Blood Money" + show Flash3 = "Escalation" + show Flash4 = "Intervention" + show Flash5 = "Martial Law" + show Flash6 = "Quorum" + show Red1 = "Daedalus Complex" + show Red2 = "Station One" + show Red3 = "Earth's Scion" + show Red4 = "Blood and Water" + show Red5 = "Free Mars" + show Red6 = "Crimson Dust" + show Kitara1 = "Sovereign Sight" + show Kitara2 = "Down the White Nile" + show Kitara3 = "Council of the Crest" + show Kitara4 = "The Devil and the Dragon" + show Kitara5 = "Whispers in Nalubaale" + show Kitara6 = "Kampala Ascendent" diff --git a/Preview.hs b/Preview.hs index 6d8a253..367436f 100644 --- a/Preview.hs +++ b/Preview.hs @@ -28,5 +28,3 @@ printPreview (Just (i, o, (Bb bi), (Bb bo))) = [ cleanDP = map (\(Dp n _) -> n) printPreview Nothing = [] -toTS :: (Integer, Int, Int) -> Timestamp -toTS (y,m,d) = Ts (fromIntegral d) (fromIntegral m) y diff --git a/State.hs b/State.hs index ad37f2f..11b2157 100644 --- a/State.hs +++ b/State.hs @@ -1,11 +1,16 @@ module State where -data Timestamp = Ts Integer Integer Integer +import System.Random +import Packs type State = (Pool, BoxQueue, StdGen) -data InRot = Ir DataPack +data InRot = Ir DataPack deriving Show + data OutRot = Or DataPack Integer +instance Eq OutRot where + (Or d1 _) == (Or d2 _) = d1 == d2 + data BoxQueue = Bq [Maybe BigBox] type Pool = ([InRot], [OutRot]) diff --git a/Timestamp.hs b/Timestamp.hs index 756691a..f41f61d 100644 --- a/Timestamp.hs +++ b/Timestamp.hs @@ -1,5 +1,7 @@ module Timestamp where +data Timestamp = Ts Integer Integer Integer deriving Show + isPreviewSeason :: Timestamp -> Bool isPreviewSeason (Ts x _ _) = x >= 20