TimePiece-0.0.1: Main.hs

module Main where
import System.Time
import System.Random
import System.Locale
import Control.Monad
import Graphics.UI.SDL as SDL

import Internals (getScreenWidth, getScreenHeight, getDataFileName)
import Zoom
import Image
import Tiles
import Render
import Cache

data Status
    = Static  { sTime :: String }
    | ZoomIn  { sTime :: String, sZoom :: Zoom, sSpeed :: Speed }
    | ZoomOut { sTime :: String, sZoom :: Zoom, sSpeed :: Speed }

main :: IO ()
main = initSDL $ \screen -> loop (Static "") $ \status -> do
    time' <- getCurrentTime
    case status of
        Static{ sTime = t } | t == time' -> do
            SDL.delay 50
            return status
        Static{} -> do
            paintScreen screen time' noZoom
            if last time' == '0'
                then initZoomIn time'
                else return status{ sTime = time' }
        ZoomIn{ sZoom = z, sSpeed = s } -> do
            paintScreen screen time' z
            -- print $ z
            let ratio' = fixRatio $ ratio z + s
            return $ if ratio z >= maxBound
                then ZoomOut
                    { sTime  = time'
                    , sZoom  = z
                    , sSpeed = 0.05
                    }
                else status
                    { sTime  = time'
                    , sZoom  = z{ ratio = ratio' }
                    , sSpeed = (maxBound - ratio z) / 50 + 0.01
                    }
        ZoomOut{ sZoom = z, sSpeed = s } -> do
            paintScreen screen time' z
            let ratio' = fixRatio $ ratio z - s
            return $ if ratio z <= minBound
                then Static{ sTime = time' }
                else status
                    { sTime = time'
                    , sZoom = z{ ratio = ratio' }
                    }

data Tiling = MkTiling
    { tTiles :: Tiles
    , tSeeds :: [Int]
    , tEdge  :: Point
    }

{-# NOINLINE _calculateTiling #-}
_calculateTiling :: CacheOnce String [Tiling]
_calculateTiling = initCache newCacheOnce
calculateTiling :: String -> IO [Tiling]
calculateTiling = cacheOnce _calculateTiling $ \time -> forM time $ \ch -> do
    ttf     <- getDataFileName "TimePiece.ttf"
    pts     <- renderChar ttf 22 ch
    tiling  <- makeRandomTiles pts
    seeds   <- forM tiling . const $ randomRIO (1, 3)
    return $ MkTiling tiling seeds (edgePoint (toPointSet pts))

paintScreen :: Surface -> String -> Zoom -> IO ()
paintScreen screen time zoom = do
    w <- getScreenWidth
    h <- getScreenHeight
    bgColor <- mapRGB (surfaceGetPixelFormat screen) 0x00 0x00 0x33
    fillRect screen Nothing bgColor
    rvs <- calculateTiling time
    let maxX  = 10 -- maximum (map pointX edges)
        maxY  = maximum (map pointY edges)
        edges = map tEdge rvs
    forM_ ([0..] `zip` rvs) $ \(n, MkTiling tiles seeds edge) -> do
        let tiles' = map adjust tiles
            adjust (MkPoint x y, sz) = (MkPoint (x + deltaX) (y + deltaY), sz)
            deltaX = (maxX - pointX edge + 1) `div` 2 + 1
            deltaY = (maxY - pointY edge + 1) `div` 2 + 1
        forM_ (tiles' `zip` seeds) $ \(tile, seed) -> do
            let x = (((16 * 15 * n) `div` 2) + ((w - 964) `div` 2))
                y = (h - 288) `div` 2
            blitTile x y screen seed zoom tile
    SDL.flip screen

getCurrentTime :: IO String
getCurrentTime = do
    fmap (formatCalendarTime defaultTimeLocale "%H:%M:%S")
        . toCalendarTime =<< getClockTime

loop :: Status -> (Status -> IO Status) -> IO ()
loop x f = f x >>= \x' -> do
    event <- pollEvent
    case event of
        Quit -> return ()
        KeyDown (Keysym SDLK_SPACE _ _) -> do
            status <- initZoomIn (sTime x')
            loop status f
        KeyDown (Keysym SDLK_k _ _) -> loop x' f
        KeyDown{}           -> return ()
        MouseButtonDown{}   -> return ()
        _                   -> loop x' f

initZoomIn :: String -> IO Status
initZoomIn time' = do
    w <- getScreenWidth
    h <- getScreenHeight
    xf <- randomRIO (0, w)
    yf <- randomRIO ((h `div` 2)-96, (h `div` 2)+96)
    return $ ZoomIn
        { sZoom = MkZoom
            { ratio = 1
            , focus = MkPoint xf yf
            }
        , sTime  = time'
        , sSpeed = 0
        }