TimePiece (empty) → 0.0.1

raw patch · 44 files changed

+651/−0 lines, 44 filesdep +SDLdep +SDL-gfxdep +SDL-imagesetup-changedbinary-added

Dependencies added: SDL, SDL-gfx, SDL-image, SDL-ttf, base, containers, old-locale, old-time, random

Files

• 1/10.png binary
• 1/20.png binary
• 1/30.png binary
• 1/40.png binary
• 1/50.png binary
• 1/60.png binary
• 1/70.png binary
• 1/80.png binary
• 1/90.png binary
• 2/10.png binary
• 2/20.png binary
• 2/30.png binary
• 2/40.png binary
• 2/50.png binary
• 2/60.png binary
• 2/70.png binary
• 2/80.png binary
• 2/90.png binary
• 3/10.png binary
• 3/20.png binary
• 3/30.png binary
• 3/40.png binary
• 3/50.png binary
• 3/60.png binary
• 3/70.png binary
• 3/80.png binary
• 3/90.png binary
• Cache.hs +36/−0
• Check.hs +40/−0
• HSMain.hs +10/−0
• HSMain_stub.c +24/−0
• HSMain_stub.h +9/−0
• Image.hs +51/−0
• Internals.hs +35/−0
• LICENSE +20/−0
• Main.hs +126/−0
• Point.hs +12/−0
• Render.hs +36/−0
• Setup.lhs +3/−0
• Tiles.hs +153/−0
• TimePiece.cabal +23/−0
• TimePiece.ttf binary
• Zoom.hs +34/−0
• c_main.c +39/−0

binary file changed (absent → 969 bytes)

binary file changed (absent → 2900 bytes)

binary file changed (absent → 5743 bytes)

binary file changed (absent → 9367 bytes)

binary file changed (absent → 14258 bytes)

binary file changed (absent → 19532 bytes)

binary file changed (absent → 25580 bytes)

binary file changed (absent → 32542 bytes)

binary file changed (absent → 40056 bytes)

binary file changed (absent → 1131 bytes)

binary file changed (absent → 3359 bytes)

binary file changed (absent → 6880 bytes)

binary file changed (absent → 11736 bytes)

binary file changed (absent → 18184 bytes)

binary file changed (absent → 25755 bytes)

binary file changed (absent → 34459 bytes)

binary file changed (absent → 44846 bytes)

binary file changed (absent → 56163 bytes)

binary file changed (absent → 1076 bytes)

binary file changed (absent → 3141 bytes)

binary file changed (absent → 6247 bytes)

binary file changed (absent → 10167 bytes)

binary file changed (absent → 15340 bytes)

binary file changed (absent → 21425 bytes)

binary file changed (absent → 28547 bytes)

binary file changed (absent → 37007 bytes)

binary file changed (absent → 46459 bytes)

@@ -0,0 +1,36 @@+module Cache where+import System.IO.Unsafe+import Data.IORef+import qualified Data.Map as M++type Cache k a = IORef (M.Map k a)+type CacheOnce k a = IORef (Maybe (k, a))++initCache :: IO a -> a+initCache = unsafePerformIO++newCache :: (Eq k, Ord k) => IO (Cache k a)+newCache = newIORef (M.empty)++newCacheOnce :: Eq k => IO (CacheOnce k a)+newCacheOnce = newIORef Nothing++cacheOnce :: Eq k => CacheOnce k a -> (k -> IO a) -> k -> IO a+cacheOnce ref f key = do+    m <- readIORef ref+    case m of+        Just (k, v) | k == key -> return v+        _ -> do+            v <- f key+            writeIORef ref (Just (key, v))+            return v++cache :: (Eq k, Ord k) => Cache k a -> (k -> IO a) -> k -> IO a+cache ref f key = do+    m <- readIORef ref+    case M.lookup key m of+        Just v  -> return v+        _       -> do+            v <- f key+            modifyIORef ref (M.insert key v)+            return v

@@ -0,0 +1,40 @@+module Check where+import Data.List (sort)+import Tiles+import Render+import Test.LazySmallCheck++instance Serial Point where+    series = cons2 MkPoint++prop_tiling points = +    toPointSet points ==+    toPointSet (tilePoints $ makeTiles points)++main = do+    pts <- renderChar "test.ttf" 24 '龍'+    print pts+    putStrLn $ showPoints pts+    tiles <- makeRandomTiles pts+    putStrLn . showTiles $ tiles+    putStrLn . showPoints $ tilePoints tiles++sampleTiles :: Tiles+sampleTiles = concat+    [ [(MkPoint x 0, 1) | x <- [0..4]]+    , [(MkPoint x 1, 2) | x <- [0..5]]+    , [(MkPoint x 2, 3) | x <- [2..7]]+    , [(MkPoint x 3, 1) | x <- [3..7]]+    ]++samplePoints' :: [Point]+samplePoints' = concat+    [ [MkPoint x 0 | x <- [0..4]]+    , [MkPoint x 1 | x <- [0..5]]+    , [MkPoint x 2 | x <- [2..7]]+    , [MkPoint x 3 | x <- [3..7]]+    ]++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}+    ]

@@ -0,0 +1,10 @@+{-# LANGUAGE ForeignFunctionInterface #-}+ +module HSMain where+ +import Main+ +foreign export ccall hs_main :: IO ()+ +hs_main :: IO ()+hs_main = main

@@ -0,0 +1,24 @@+#define IN_STG_CODE 0+#include "Rts.h"+#include "Stg.h"+#ifdef __cplusplus+extern "C" {+#endif+ +extern StgClosure HSMain_zdfhszumainzuatN_closure;+void hs_main(void)+{+Capability *cap;+HaskellObj ret;+cap = rts_lock();+cap=rts_evalIO(cap,rts_apply(cap,(HaskellObj)runIO_closure,&HSMain_zdfhszumainzuatN_closure) ,&ret);+rts_checkSchedStatus("hs_main",cap);+rts_unlock(cap);+}+static void stginit_export_HSMain_zdfhszumainzuatN() __attribute__((constructor));+static void stginit_export_HSMain_zdfhszumainzuatN()+{getStablePtr((StgPtr) &HSMain_zdfhszumainzuatN_closure);}+#ifdef __cplusplus+}+#endif+

@@ -0,0 +1,9 @@+#include "HsFFI.h"+#ifdef __cplusplus+extern "C" {+#endif+extern void hs_main(void);+#ifdef __cplusplus+}+#endif+

@@ -0,0 +1,51 @@+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 ()+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+    TTF.quit++blitTile :: (Show a) => X -> Y -> Surface -> a -> Zoom -> (Point, Int) -> IO Bool+blitTile xOff yOff canvas seed z (MkPoint x y, sz) = do+    img <- loadImageSized (show seed, (sz * 9) *** z)+    let x'  = x * 9 + xOff+        y'  = y * 12 + yOff+        pos = Just (Rect (x' ~~~ z) (y' ||| z) 0 0)+    blitSurface img Nothing canvas pos++{-# NOINLINE _loadImage #-}+_loadImage :: Cache FilePath Surface+_loadImage = initCache newCache+loadImage :: FilePath -> IO Surface+loadImage = cache _loadImage SDLImage.load++{-# NOINLINE _loadImageSized #-}+_loadImageSized :: Cache (String, Int) Surface+_loadImageSized = initCache newCache+loadImageSized :: (String, Int) -> IO Surface+loadImageSized = cache _loadImageSized $ \(fn, sz) -> do+    -- Round to nearest multiples of 10+    img <- getDataFileName $ fn ++ "/" ++ show ((sz + 9) `div` 10) ++ "0.png"+    src <- loadImage img+    let r = (fromIntegral sz + 0.5) / fromIntegral srcWidth+        srcWidth = SDL.surfaceGetWidth src+    if srcWidth == sz+        then return src+        else SDLRotozoomer.zoom src r r True+

@@ -0,0 +1,35 @@+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)+

@@ -0,0 +1,20 @@+Copyright 2008 by Audrey Tang++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,126 @@+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+        }

@@ -0,0 +1,12 @@+module Point where++type X = Int+type Y = Int+type Size = Int++data Point = MkPoint+    { pointX :: !X+    , pointY :: !Y+    }+    deriving (Show, Eq, Ord)+

@@ -0,0 +1,36 @@+module Render where+import Foreign+import Point+import qualified Graphics.UI.SDL as SDL+import qualified Graphics.UI.SDL.TTF as TTF++type FontName = FilePath++renderChar :: FontName -> Size -> Char -> IO [Point]+renderChar fn size ch = do+    font            <- TTF.openFont fn size+    Just textImage  <- TTF.tryRenderGlyphSolid font ch white+    let width  = SDL.surfaceGetWidth textImage+        height = SDL.surfaceGetHeight textImage+    pixels  <- SDL.surfaceGetPixels textImage+    vals    <- peekArray (width * height) (castPtr pixels)++    let points = [ MkPoint x y | y <- [0..(height-1)], x <- [0..(width-1)] ]++    return [ pt | (pt, v) <- points `zip` vals, v > (0 :: Word8) ]++white :: SDL.Color+white = SDL.Color 255 255 255++showPixels :: SDL.Surface -> IO String+showPixels surface = do+    pixels <- SDL.surfaceGetPixels surface+    let width  = SDL.surfaceGetWidth surface+        height = SDL.surfaceGetHeight surface+        format = SDL.surfaceGetPixelFormat surface+    bpp     <- SDL.pixelFormatGetBytesPerPixel format+    vals    <- peekArray (fromEnum bpp * width * height) (castPtr pixels)+    let part [] = []+        part xs = let (r, rs) = splitAt width xs in (r:part rs)+    return . unlines $ map (map (\x -> if x > (0 :: Word8) then '*' else ' ')) (part vals)+

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,153 @@+module Tiles+    ( Point(..), PointSet, Tiles+    , makeRandomTiles, makeTiles+    , tilePoints, showTiles, showPoints+    , toPointSet, fromPointSet, showPointSet, edgePoint+    ) where+import Point+import System.Random+import Data.List (find)+import qualified Data.IntMap as IM+import qualified Data.IntSet as IS++type Tiles = [(Point, Size)]++-- Map from -X to existence of -Y+type PointSet = IM.IntMap IS.IntSet++tilePoints :: Tiles -> [Point]+tilePoints [] = []+tilePoints ((p@(MkPoint x y), 4):rest) = block ++ (p:tilePoints rest)+    where+    block = [ MkPoint (x+dx) (y+dy) | (dx, dy) <- _size2 ++ _size3 ++ _size4 ]+tilePoints ((p@(MkPoint x y), 3):rest) = block ++ (p:tilePoints rest)+    where+    block = [ MkPoint (x+dx) (y+dy) | (dx, dy) <- _size2 ++ _size3 ]+tilePoints ((p@(MkPoint x y), 2):rest) = block ++ (p:tilePoints rest)+    where+    block = [ MkPoint (x+dx) (y+dy) | (dx, dy) <- _size2 ]+tilePoints ((p, _):rest) = (p:tilePoints rest)++makeTiles :: [Point] -> Tiles+makeTiles [] = []+makeTiles points = (m:makeTiles rest')+    where+    ps = toPointSet points+    (m@(_, msz), rest) = case find ((== 4) . snd) tilings of+        Just m4 -> (m4, points)+        _       -> case find ((== 3) . snd) tilings of+            Just m3 -> (m3, points)+            _       -> case find ((== 2) . snd) tilings of+                Just m2 -> (m2, points)+                _       -> ((head points, 1), tail points)+    rest' = if msz == 1 then rest else filter (not . inArea m) rest+    tilings = [ (p, getTileSize p ps) | p <- points ]++makeRandomTiles :: [Point] -> IO Tiles+makeRandomTiles = fmap makeTiles . shuffle++insertPoint :: Point -> PointSet -> PointSet+insertPoint (MkPoint px py) ps = IM.insert x ys' ps+    where+    x   = -px+    y   = -py+    ys' = case IM.lookup x ps of+        Just ys -> IS.insert y ys+        _       -> IS.singleton y+    ++lookupPoint :: Point -> PointSet -> Bool+lookupPoint (MkPoint px py) ps = case IM.lookup x ps of+    Just ys -> IS.member y ys+    _       -> False+    where+    x = -px+    y = -py++{-+deletePoint :: Point -> PointSet -> PointSet+deletePoint (MkPoint px py) = IM.update doUpdate x+    where+    x = -px+    y = -py+    doUpdate ys = if IS.null ys' then Nothing else Just ys'+        where+        ys' = IS.delete y ys+-}++-- At least we have size 1; the goal is to check for bigger sizes. +getTileSize :: Point -> PointSet -> Size+getTileSize (MkPoint x y) ps+    | all ok _size2 = if all ok _size3 then if all ok _size4 then 4 else 3 else 2+    | otherwise = 1+    where+    ok (dx, dy) = lookupPoint (MkPoint (x+dx) (y+dy)) ps++_size2, _size3, _size4 :: [(X, Y)]+_size2 = [(1, 0), (0, 1), (1, 1)]+_size3 = [(2, 0), (2, 1), (0, 2), (1, 2), (2, 2)]+_size4 = [(3, 0), (3, 1), (3, 2), (0, 3), (1, 3), (2, 3), (3, 3)]++-- The bottom right edge of a point set+edgePoint :: PointSet -> Point+edgePoint ps = MkPoint (-x) (-y)+    where+    x = head (IM.keys ps)+    y = minimum $ map (head . IS.elems) (IM.elems ps)++shuffle :: [a] -> IO [a]+shuffle [] = return []+shuffle [c] = return [c]+shuffle deck0 = part deck0 [] []+    where+    part [] p0 p1 = do+        s1 <- shuffle p0+        s2 <- shuffle p1+        return (s1 ++ s2)+    part (d : deck) p0 p1 = do+        n <- randomRIO (False, True)+        if n then part deck (d : p0) p1+             else part deck p0 (d : p1)++inArea :: (Point, Size) -> Point -> Bool+inArea (MkPoint x y, sz) (MkPoint tx ty)+    =  dx >= 0 && dx < sz+    && dy >= 0 && dy < sz+    where+    dx = tx - x+    dy = ty - y++-- doMakeTiles :: PointSet -> Tiles++showTiles :: Tiles -> String+showTiles mosaic = unlines+    [   [ case lookup (MkPoint x y) mosaic of+            Just sz -> toEnum (48 + sz)+            _       -> ' '+        | x <- [0..maxX]+        ]+    | y <- [0..maxY]+    ]+    where+    pts  = map fst mosaic+    maxX = maximum (map pointX pts)+    maxY = maximum (map pointY pts)++showPoints :: [Point] -> String+showPoints = showPointSet . toPointSet++showPointSet :: PointSet -> String+showPointSet ps = unlines+    [   [ if lookupPoint (MkPoint x y) ps then '*' else ' '+        | x <- [0..maxX]+        ]+    | y <- [0..maxY]+    ]+    where+    MkPoint maxX maxY = edgePoint ps++toPointSet :: [Point] -> PointSet+toPointSet = foldl (flip insertPoint) IM.empty++fromPointSet :: PointSet -> [Point]+fromPointSet ps = concat [ [ MkPoint x y | y <- IS.elems ys ] | (x, ys) <- IM.assocs ps ]

@@ -0,0 +1,23 @@+Name:               TimePiece+Version:            0.0.1+Synopsis:           A simple tile-based digital clock screen saver+Description:        A simple tile-based digital clock screen saver+License:            BSD3+License-File:       LICENSE+Category:           Screensaver+Author:             Audrey Tang+Maintainer:         Audrey Tang <audreyt@audreyt.org>+Build-Depends:      base, SDL >= 0.5.4, SDL-image, SDL-ttf, SDL-gfx, containers, random, old-locale, old-time+Build-Type:         Simple+Data-Files:         1/10.png 1/20.png 1/30.png 1/40.png 1/50.png 1/60.png 1/70.png 1/80.png 1/90.png+                    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+ +Executable:         TimePiece+HS-Source-Dirs:     .+Main-Is:            HSMain.hs+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

binary file changed (absent → 21296 bytes)

@@ -0,0 +1,34 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Zoom where+import Point++newtype Ratio = MkRatio { fromRatio :: Double }+    deriving (Show, RealFrac, Fractional, Real, Ord, Num, Eq, Enum)+type Speed = Ratio++data Zoom = MkZoom+    { ratio :: !Ratio+    , focus :: !Point+    }+    deriving Show++noZoom :: Zoom+noZoom = MkZoom 1 (MkPoint 0 0)++fixRatio :: Ratio -> Ratio+fixRatio = min maxBound . max minBound++instance Bounded Ratio where+    minBound = 1+    maxBound = 2++(***) :: (Integral b, Integral a) => a -> Zoom -> b+x *** MkZoom r _ = round (fromIntegral x * r)++(~~~) :: (Integral b, Integral a) => a -> Zoom -> b+x ~~~ MkZoom r (MkPoint dx _) = +    round (fromIntegral x * r + ((fromIntegral dx - 256) * 2 / pred maxBound) * (1-r))++(|||) :: (Integral b, Integral a) => a -> Zoom -> b+y ||| MkZoom r (MkPoint _ dy) = +    round (fromIntegral y * r + ((fromIntegral dy - 192) * 2 / pred maxBound) * (1-r))

@@ -0,0 +1,39 @@+#include <stdio.h>+#include "HsFFI.h"+ +#ifdef __APPLE__+#include <objc/objc.h>+#include <objc/objc-runtime.h>+#endif+ +#include <SDL.h>+ +#ifdef __GLASGOW_HASKELL__+#include "HSMain_stub.h"+extern void __stginit_HSMain ( void );+#endif+ +int SDL_main(int argc, char *argv[])+{+    int i;+ +#ifdef __APPLE__+    void * pool =+      objc_msgSend(objc_lookUpClass("NSAutoreleasePool"), sel_getUid("alloc"));+    objc_msgSend(pool, sel_getUid("init"));+#endif+ +    hs_init(&argc, &argv);+#ifdef __GLASGOW_HASKELL__+    hs_add_root(__stginit_HSMain);+#endif+ +    hs_main();+ +    hs_exit();+ +#ifdef __APPLE__+    objc_msgSend(pool, sel_getUid("release"));+#endif+    return 0;+}