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 }