tA/p7
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Working

Browse Source
This commit is contained in:
Shaun Kerr 2018-06-25 11:21:29 +12:00
parent a1fb205b66
commit 7ef4f7fed8
9 changed files with 106 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitignore vendored Normal file
View File

@ -0,0 +1,3 @@
*.hi
*.o
*.swp

19
Config.hs
View File

@ -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
View File

@ -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

BIN
Main Executable file
View File

Binary file not shown.

25
Main.hs
View File

@ -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
View File

@ -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"

2
Preview.hs
View File

@ -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
View File

@ -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])

2
Timestamp.hs
View File

@ -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