TimePiece 0.0.1 → 0.0.2
raw patch · 9 files changed
+62/−89 lines, 9 files
Files
- Check.hs +5/−1
- HSMain.hs +0/−2
- Image.hs +7/−9
- Internals.hs +0/−35
- Main.hs +41/−39
- Paths.hs +2/−0
- Point.hs +0/−1
- TimePiece.cabal +4/−2
- Zoom.hs +3/−0
Check.hs view
@@ -36,5 +36,9 @@ ] samplePoints = - [MkPoint {pointX = 0, pointY = 1},MkPoint {pointX = 0, pointY = 0},MkPoint {pointX = 0, pointY = 0},MkPoint {pointX = 1, pointY = 0},MkPoint {pointX = 1, pointY = 1}+ [ MkPoint {pointX = 0, pointY = 1}+ , MkPoint {pointX = 0, pointY = 0}+ , MkPoint {pointX = 0, pointY = 0}+ , MkPoint {pointX = 1, pointY = 0}+ , MkPoint {pointX = 1, pointY = 1} ]
HSMain.hs view
@@ -1,7 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface #-}- module HSMain where- import Main foreign export ccall hs_main :: IO ()
Image.hs view
@@ -1,24 +1,23 @@ module Image where-import Internals (setScreenWidth, setScreenHeight, getDataFileName)-import Cache-import Point-import Zoom import Graphics.UI.SDL as SDL import qualified Graphics.UI.SDL.TTF as TTF import qualified Graphics.UI.SDL.Image as SDLImage import qualified Graphics.UI.SDL.Rotozoomer as SDLRotozoomer -initSDL :: (Surface -> IO a) -> IO ()+import Zoom+import Cache+import Paths+import Point++initSDL :: (Surface -> Int -> Int -> IO a) -> IO () initSDL f = SDL.withInit [InitTimer, InitAudio, InitVideo] $ do info <- getVideoInfo let w = videoInfoWidth info h = videoInfoHeight info- setScreenWidth w - setScreenHeight h screen <- setVideoMode w h 32 [AnyFormat, Fullscreen, HWAccel, HWSurface, DoubleBuf] TTF.init- f screen+ f screen w h TTF.quit blitTile :: (Show a) => X -> Y -> Surface -> a -> Zoom -> (Point, Int) -> IO Bool@@ -48,4 +47,3 @@ if srcWidth == sz then return src else SDLRotozoomer.zoom src r r True-
− Internals.hs
@@ -1,35 +0,0 @@-module Internals ( getDataFileName, module Internals ) where-import Paths_TimePiece-import System.IO.Unsafe-import Data.IORef--{-# NOINLINE _WIDTH_ #-}-_WIDTH_ :: IORef Integer-_WIDTH_ = unsafePerformIO $ newIORef 1024--{-# NOINLINE _HEIGHT_ #-}-_HEIGHT_ :: IORef Integer-_HEIGHT_ = unsafePerformIO $ newIORef 768--getScreenWidth :: Num a => IO a-getScreenWidth = fmap fromIntegral (readIORef _WIDTH_)--getScreenHeight :: Num a => IO a-getScreenHeight = fmap fromIntegral (readIORef _HEIGHT_)--setScreenWidth :: Integral a => a -> IO ()-setScreenWidth = writeIORef _WIDTH_ . toInteger--setScreenHeight :: Integral a => a -> IO ()-setScreenHeight = writeIORef _HEIGHT_ . toInteger--type X = Int-type Y = Int-type Size = Int--data Point = MkPoint- { pointX :: !X- , pointY :: !Y- }- deriving (Show, Eq, Ord)-
Main.hs view
@@ -1,57 +1,61 @@ module Main where import System.Time-import System.Random import System.Locale+import System.Random import Control.Monad import Graphics.UI.SDL as SDL -import Internals (getScreenWidth, getScreenHeight, getDataFileName)-import Zoom+import Cache import Image+import Paths import Tiles import Render-import Cache+import Zoom data Status- = Static { sTime :: String }- | ZoomIn { sTime :: String, sZoom :: Zoom, sSpeed :: Speed }- | ZoomOut { sTime :: String, sZoom :: Zoom, sSpeed :: Speed }+ = Static { sWidth :: Int, sHeight :: Int, sTime :: String }+ | ZoomIn { sWidth :: Int, sHeight :: Int, sTime :: String, sZoom :: Zoom, sSpeed :: Speed }+ | ZoomOut { sWidth :: Int, sHeight :: Int, sTime :: String, sZoom :: Zoom, sSpeed :: Speed } main :: IO ()-main = initSDL $ \screen -> loop (Static "") $ \status -> do+main = initSDL $ \screen initW initH -> loop (Static initW initH "") $ \status -> do time' <- getCurrentTime+ let paint = paintScreen screen (sWidth status) (sHeight status) time' case status of Static{ sTime = t } | t == time' -> do SDL.delay 50 return status Static{} -> do- paintScreen screen time' noZoom+ paint noZoom if last time' == '0'- then initZoomIn time'+ then initZoomIn time' (sWidth status) (sHeight status) else return status{ sTime = time' }- ZoomIn{ sZoom = z, sSpeed = s } -> do- paintScreen screen time' z- -- print $ z- let ratio' = fixRatio $ ratio z + s+ ZoomIn{ sZoom = z, sWidth = w, sHeight = h, sSpeed = s } -> do+ paint z return $ if ratio z >= maxBound then ZoomOut- { sTime = time'- , sZoom = z- , sSpeed = 0.05+ { sTime = time'+ , sZoom = z+ , sSpeed = 0.05+ , sWidth = w+ , sHeight = h } else status { sTime = time'- , sZoom = z{ ratio = ratio' }+ , sZoom = nextZoom z (+ s) , sSpeed = (maxBound - ratio z) / 50 + 0.01 }- ZoomOut{ sZoom = z, sSpeed = s } -> do- paintScreen screen time' z- let ratio' = fixRatio $ ratio z - s+ ZoomOut{ sZoom = z, sWidth = w, sHeight = h, sSpeed = s } -> do+ paint z return $ if ratio z <= minBound- then Static{ sTime = time' }+ then Static+ { sTime = time'+ , sWidth = w+ , sHeight = h+ } else status { sTime = time'- , sZoom = z{ ratio = ratio' }+ , sZoom = nextZoom z (subtract s) } data Tiling = MkTiling@@ -71,10 +75,8 @@ 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+paintScreen :: Surface -> Int -> Int -> String -> Zoom -> IO ()+paintScreen screen w h time zoom = do bgColor <- mapRGB (surfaceGetPixelFormat screen) 0x00 0x00 0x33 fillRect screen Nothing bgColor rvs <- calculateTiling time@@ -98,29 +100,29 @@ . toCalendarTime =<< getClockTime loop :: Status -> (Status -> IO Status) -> IO ()-loop x f = f x >>= \x' -> do+loop status f = f status >>= \status' -> 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+ status'' <- initZoomIn (sTime status') (sWidth status') (sHeight status')+ loop status'' f+ KeyDown (Keysym SDLK_k _ _) -> loop status' f KeyDown{} -> return () MouseButtonDown{} -> return ()- _ -> loop x' f+ _ -> loop status' f -initZoomIn :: String -> IO Status-initZoomIn time' = do- w <- getScreenWidth- h <- getScreenHeight+initZoomIn :: String -> Int -> Int -> IO Status+initZoomIn time' w h = do xf <- randomRIO (0, w) yf <- randomRIO ((h `div` 2)-96, (h `div` 2)+96) return $ ZoomIn- { sZoom = MkZoom+ { sZoom = MkZoom { ratio = 1 , focus = MkPoint xf yf }- , sTime = time'- , sSpeed = 0+ , sTime = time'+ , sSpeed = 0+ , sWidth = w+ , sHeight = h }
+ Paths.hs view
@@ -0,0 +1,2 @@+module Paths ( getDataFileName ) where+import Paths_TimePiece
Point.hs view
@@ -9,4 +9,3 @@ , pointY :: !Y } deriving (Show, Eq, Ord)-
TimePiece.cabal view
@@ -1,5 +1,5 @@ Name: TimePiece-Version: 0.0.1+Version: 0.0.2 Synopsis: A simple tile-based digital clock screen saver Description: A simple tile-based digital clock screen saver License: BSD3@@ -13,6 +13,7 @@ 2/10.png 2/20.png 2/30.png 2/40.png 2/50.png 2/60.png 2/70.png 2/80.png 2/90.png 3/10.png 3/20.png 3/30.png 3/40.png 3/50.png 3/60.png 3/70.png 3/80.png 3/90.png HSMain_stub.c HSMain_stub.h TimePiece.ttf+Extra-Source-Files: Check.hs Executable: TimePiece HS-Source-Dirs: .@@ -20,4 +21,5 @@ GHC-Options: -no-hs-main -Wall C-Sources: c_main.c Extra-Libraries: SDLmain-Other-Modules: Cache Check Image Internals Main Point Render Tiles Zoom+Extensions: GeneralizedNewtypeDeriving, ForeignFunctionInterface+Other-Modules: Cache Image Paths Main Point Render Tiles Zoom
Zoom.hs view
@@ -15,6 +15,9 @@ noZoom :: Zoom noZoom = MkZoom 1 (MkPoint 0 0) +nextZoom :: Zoom -> (Ratio -> Ratio) -> Zoom+nextZoom z f = z{ ratio = fixRatio $ f (ratio z) }+ fixRatio :: Ratio -> Ratio fixRatio = min maxBound . max minBound