Created
September 4, 2011 14:26
-
-
Save oliland/1192924 to your computer and use it in GitHub Desktop.
Dawn of the nth Day
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| module Main where | |
| import System( getArgs ) | |
| import Data.Char | |
| import Control.Exception (bracket_) | |
| import qualified UI.HSCurses.Curses as Curses | |
| import qualified UI.HSCurses.CursesHelper as CursesH | |
| import Data.Time.Clock | |
| import Data.Time.Calendar | |
| start = do | |
| args <- getArgs | |
| hremain <- hoursremain | |
| dsin <- daysin | |
| let tday = days (fromIntegral dsin) 1 | |
| Curses.initScr | |
| Curses.keypad Curses.stdScr True | |
| Curses.echo False | |
| Curses.nl False | |
| Curses.cBreak True | |
| hasColors <- Curses.hasColors | |
| if hasColors | |
| then do | |
| Curses.startColor | |
| Curses.initPair (Curses.Pair 1) (CursesH.white) (CursesH.black) | |
| return () | |
| else | |
| return () | |
| Curses.wclear Curses.stdScr | |
| (sizeY, sizeX) <- Curses.scrSize | |
| Curses.wMove Curses.stdScr ((sizeY `div` 2)-1) ((sizeX `div` 2) - (length((tday)!!0) `div` 2 )) | |
| Curses.wAddStr Curses.stdScr ((tday)!!0) | |
| Curses.attrOn (Curses.setBold Curses.attr0 True) | |
| Curses.wMove Curses.stdScr ((sizeY `div` 2)) ((sizeX `div` 2) - (length((tday)!!1) `div` 2 )) | |
| Curses.wAddStr Curses.stdScr ((tday)!!1) | |
| Curses.attrOff (Curses.setBold Curses.attr0 True) | |
| Curses.wMove Curses.stdScr ((sizeY `div` 2)+1) ((sizeX `div` 2) - (length(hremain) `div` 2 )) | |
| Curses.wAddStr Curses.stdScr (hremain) | |
| Curses.wMove Curses.stdScr (sizeY-1) ((sizeX `div` 2) - (length(continue) `div` 2 )) | |
| Curses.wAddStr Curses.stdScr continue | |
| return () | |
| loop num = do | |
| c <- Curses.getch | |
| Curses.attrSet Curses.attr0 (Curses.Pair 1) | |
| if Curses.decodeKey c == Curses.KeyChar 'q' | |
| then return() | |
| else loop (num + 1) | |
| end = do | |
| Curses.endWin | |
| return () | |
| main = do | |
| bracket_ start end (loop 0) | |
| firstday = (2011,9,1) --set this to the first day of internship | |
| lastday = (2011,9,30) --set this to the last day of internship | |
| boobday :: IO (Integer, Int, Int) | |
| boobday = getCurrentTime >>= return . toGregorian . utctDay | |
| monthdays month year = gregorianMonthLength year month | |
| daysin :: IO (Int) | |
| daysin = do | |
| bd <- boobday | |
| return $ diffdays firstday bd | |
| hoursleft :: IO (Int) | |
| hoursleft = do | |
| bd <- boobday | |
| return $ diffhours bd lastday | |
| hoursremain :: IO (String) | |
| hoursremain = do | |
| hl <- hoursleft | |
| return $ '-':(show hl)++" Hours Remain-" | |
| daysleft :: IO (Int) | |
| daysleft = do | |
| bd <- boobday | |
| return $ diffdays bd lastday | |
| diffdays (x,y,z) (x',y',z') = foldr (+) 0 [ monthdays m x | m<-[y..y'-1] ] + (z'-z) +1 | |
| diffhours a b = 24*(diffdays a b) | |
| days :: Integer -> Integer -> [String] | |
| days x y = "Dawn of":("The "++lcap(concat(daystring(show x)))):("-"++show (24*(y-x)+24)++" Hours Remain-"):[] | |
| lcap :: String -> String | |
| lcap x = toUpper(head x):tail x | |
| continue :: String | |
| continue = "Press Q to continue." | |
| daystring :: String -> [String] | |
| daystring [] = [] | |
| daystring x | ((length x == 4) && (tail x == "000")) = dig(head x):"-thousandth day":[] | |
| | ((length x == 4) && (head (tail x) == '0')) = dig(head x):"-thousand-and-":daystring(tail(tail x)) | |
| | (length x == 4) = dig(head x):"-thousand, ":daystring(tail x) | |
| | ((length x == 3) && (tail x == "00")) = dig(head x):"-hundredth day":[] | |
| | (length x == 3) = dig(head x):"-hundred-and-":daystring(tail x) | |
| | ((length x == 2) && (head x == '0')) = daystring(tail x) | |
| | ((length x == 2) && (head x /= '1') && (tail x /= "0") ) = dig2(head x):daystring(tail x) | |
| | ((length x == 2) && (head x /= '1')) = x0(x):"Day":[] | |
| | (length x == 2) = teen(x):"Day":[] | |
| | (length x == 1) = dig1(x):"Day":[] | |
| dig :: Char -> String | |
| dig x = ["one","two","three","four","five","six","seven","eight","nine"] !! (digitToInt(x)-1) | |
| x0 :: String -> String | |
| x0 x = ["twentieth ","thirtieth ","fourtieth ","fiftieth ","sixtieth ","seventieth ","eightieth ","ninetieth "] !! round((read(x)/10)-2) | |
| dig2 :: Char -> String | |
| dig2 x = ["twenty-","thirty-","fourty-","fifty-","sixty-","seventy-","eighty-","ninety-"] !! (digitToInt(x)-2) | |
| teen :: String -> String | |
| teen x = ["tenth ","eleventh ","twelfth ","thirteenth ","fourteenth ","fifteenth ","sixteenth ","seventeenth ","eighteenth ","nineteenth "] !!(read(x)-10) | |
| dig1 :: String -> String | |
| dig1 x = ["first ","second ","third ","fourth ","fifth ","sixth ","seventh ","eighth ","ninth "] !! (read(x)-1) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment