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