@@ -0,0 +1,3 @@ | |||
*.hi | |||
*.o | |||
*.swp |
@@ -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 |
@@ -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 | |||
@@ -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])) | |||
] |
@@ -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" |
@@ -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 |
@@ -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]) | |||
@@ -1,5 +1,7 @@ | |||
module Timestamp where | |||
data Timestamp = Ts Integer Integer Integer deriving Show | |||
isPreviewSeason :: Timestamp -> Bool | |||
isPreviewSeason (Ts x _ _) = x >= 20 | |||