diff --git a/call.cabal b/call.cabal
--- a/call.cabal
+++ b/call.cabal
@@ -1,5 +1,5 @@
 name:                call
-version:             0.1.4.2
+version:             0.2
 synopsis:            The call game engine
 description:         Call is a minimalistic game engine that supports 2D/3D graphics and sounds.
 homepage:            https://github.com/fumieval/call
@@ -12,7 +12,6 @@
 build-type:          Simple
 data-files:
   shaders/*.glsl
-  data/*.ttf
 cabal-version:       >=1.10
 
 flag BuildHelloWorld
@@ -31,25 +30,17 @@
 library
   exposed-modules:
     Call
-    Call.Types
-    Call.TH
-    Call.System
-    Call.Sight
     Call.Internal.GLFW
     Call.Internal.PortAudio
-    Call.Data.Wave
-    Call.Data.Font
-    Call.Data.Bitmap
-    Call.Util.Deck
-    Call.Util.Sampler
-    Call.Util.Text
   other-modules:
     Paths_call
   ghc-options: -Wall -fexcess-precision -O2 -optc-ffast-math
   other-extensions:    Rank2Types, DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveDataTypeable, TemplateHaskell, CPP, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances, ScopedTypeVariables, FlexibleInstances, FlexibleContexts, KindSignatures, TypeFamilies, BangPatterns, ViewPatterns, LambdaCase, DataKinds, GADTs
   build-depends:
+    audiovisual,
     base >=4.6 && <5,
     bindings-portaudio,
+    audiovisual,
     boundingboxes >=0.2 && <0.4,
     colors >=0.3 && <0.4,
     containers >=0.5 && <0.7,
@@ -74,6 +65,7 @@
     transformers >=0.3 && <0.5,
     vector >=0.9 && <0.13,
     WAVE >=0.1 && <0.2,
+    reflection,
     deepseq
   hs-source-dirs:      src
   default-language:    Haskell2010
diff --git a/data/VL-PGothic-Regular.ttf b/data/VL-PGothic-Regular.ttf
deleted file mode 100644
# file too large to diff: data/VL-PGothic-Regular.ttf
diff --git a/shaders/fragment.glsl b/shaders/fragment.glsl
--- a/shaders/fragment.glsl
+++ b/shaders/fragment.glsl
@@ -2,24 +2,29 @@
 out vec4 fragColor;
 
 // Texture
-in vec2 UV;
-in vec2 envUV;
+in vec2 texUV;
 
 in vec3 normal;
 in vec3 lightDir;
 
-uniform sampler2D env;
 uniform sampler2D tex;
+uniform sampler2D normalMap;
 
 uniform vec4 diffuse;
+uniform vec3 specular;
 uniform float normalMix;
 uniform float textureMix;
 
 void main(void){
-  // vec3 n = mix(normal, texture(normalMap, UV).rgb * 2 - 1, normalMix);
+  vec3 n = mix(normal, texture(normalMap, texUV).rgb * 2 - 1, normalMix);
 
-  vec4 d = mix(vec4(1.0), texture(tex, UV).rgba, textureMix) * diffuse;
+  vec4 d = mix(vec4(1.0), texture(tex, texUV).rgba, textureMix) * diffuse;
 
-  fragColor = vec4(d.rgb, d.a);
+  vec3 view = vec3(0,0,1);
+  float brightness = 1.0;
+
+  float shine = dot(reflect(lightDir, n), view);
+
+  fragColor = vec4(d.rgb * brightness + specular * shine, d.a);
 
 }
diff --git a/shaders/vertex.glsl b/shaders/vertex.glsl
--- a/shaders/vertex.glsl
+++ b/shaders/vertex.glsl
@@ -2,13 +2,15 @@
 uniform mat4 projection;
 uniform mat4 matrices[13];
 uniform int level;
-uniform bool useEnv;
-out vec2 UV;
-out vec2 envUV;
+
 in vec3 in_Position;
 in vec2 in_UV;
 in vec3 in_Normal;
 
+out vec2 texUV;
+out vec3 normal;
+out vec3 lightDir;
+
 void main(void) {
   mat4 model = mat4(1.0);
   for(int i=0; i < level; i++)
@@ -16,5 +18,7 @@
     model *= matrices[i];
   }
   gl_Position = projection * model * vec4(in_Position, 1.0);
-  UV = in_UV;
+  texUV = in_UV;
+  normal = in_Normal;
+  lightDir = vec3(0.0, 0.0, 0.0);
 }
diff --git a/src/Call.hs b/src/Call.hs
--- a/src/Call.hs
+++ b/src/Call.hs
@@ -1,45 +1,435 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE Rank2Types #-}
-module Call ( -- * System
-    runSystemDefault,
-    readBitmap,
-    module Call.Sight,
-    module Call.System,
-    module Call.Types,
-    module Call.TH,
-    module Call.Data.Wave,
-    module Call.Data.Font,
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE CPP #-}
+module Call (
+  runCallDefault
+  , readBitmap
+  -- * The system
+  , Call
+  , Foundation
+  , runCall
+  , WindowMode(..)
+  -- * Time
+  , stand
+  , wait
+  , getTime
+  , setFPS
+  , getSlowdown
+  , getFPS
+  -- * Raw input
+  , keyPress
+  , mousePosition
+  , mouseButton
+  , enableCursor
+  , hideCursor
+  , disableCursor
+  , getGamepads
+  , gamepadButtons
+  , gamepadAxes
+  -- * Component
+  , linkGraphic
+  , linkPicture
+  , linkAudio
+  , linkKeyboard
+  , linkMouse
+  , linkGamepad
+  -- * Others
+  , setTitle
+  , clearColor
+  , getBoundingBox
+  , setBoundingBox
+  , takeScreenshot
     -- * Reexports
-    module Control.Monad,
-    module Control.Applicative,
-    module Control.Bool,
-    module Data.Monoid,
-    module Data.Color,
-    module Data.Color.Names,
-    module Linear,
-    module Control.Object,
-    module Control.Monad.IO.Class
+  , module Data.Audio
+  , module Data.Graphics
+  , module Data.Input.Event
+  , module Control.Monad
+  , module Control.Applicative
+  , module Control.Bool
+  , module Data.Monoid
+  , module Data.Color
+  , module Data.Color.Names
+  , module Linear
+  , module Control.Object
+  , module Control.Monad.IO.Class
 ) where
 
-import Call.TH
-import Call.Types
-import Call.Data.Wave
-import Call.Data.Font
-import Call.Sight
-import Call.System
-import Control.Monad.IO.Class
-import Control.Monad
 import Control.Applicative
 import Control.Bool
+import Control.Concurrent
+import Control.Exception
+import Control.Lens
+import Control.Monad hiding (sequence, sequence_, mapM, mapM_, forM, forM_, msum)
+import Control.Monad.IO.Class
 import Control.Object
+import Data.Audio
+import Data.BoundingBox
 import Data.Color
 import Data.Color.Names
+import Data.Traversable as T
+import Data.Foldable as F hiding (foldr)
+import Data.Typeable
+import Data.Graphics as U
+import Data.Graphics
+import Data.Graphics.Bitmap as Bitmap
+import Data.Input.Event
+import Data.IORef
+import Data.Maybe
 import Data.Monoid
+import Data.Reflection
+import Foreign (castPtr, sizeOf, with)
+import Graphics.Rendering.OpenGL.GL.StateVar
 import Linear
-import Data.BoundingBox
-import qualified Call.Data.Bitmap as Bitmap
+import qualified Call.Internal.GLFW as G
+import qualified Call.Internal.PortAudio as PA
+import qualified Codec.Picture as C
+import qualified Data.Map.Strict as Map
+import qualified Data.IntMap.Strict as IM
+import qualified Data.Vector.Storable as V
+import qualified Graphics.Rendering.OpenGL.GL as GL
+import qualified Graphics.Rendering.OpenGL.Raw as GL
+import qualified Graphics.UI.GLFW as GLFW
+import Unsafe.Coerce
 
-runSystemDefault :: (forall s. System s a) -> IO (Maybe a)
-runSystemDefault = runSystem Windowed (Box (V2 0 0) (V2 640 480))
+data WindowMode = Windowed | Resizable | FullScreen deriving (Show, Eq, Ord, Read, Typeable)
 
+runCallDefault :: (Call => IO a) -> IO (Maybe a)
+runCallDefault = runCall Windowed (Box (V2 0 0) (V2 640 480))
+
 readBitmap :: MonadIO m => FilePath -> m Bitmap.Bitmap
 readBitmap = Bitmap.readFile
+
+setFPS :: Call => Float -> IO ()
+setFPS f = writeIORef (targetFPS given) f
+
+-- | @(Actual FPS) = (Target FPS) / (1 + (Slowdown))@
+getFPS :: Call => IO Float
+getFPS = do
+  t <- readIORef (targetFPS given)
+  r <- getSlowdown
+  return $ t / (1 + r)
+
+type Call = Given Foundation
+
+linkGraphic :: Call => (Time -> IO Sight) -> IO ()
+linkGraphic f = do
+  g <- readIORef $ coreGraphic given
+  writeIORef (coreGraphic given) $ \dt -> liftA2 (<>) (f dt) (g dt)
+
+linkPicture :: Call => (Time -> IO Picture) -> IO ()
+linkPicture f = linkGraphic (fmap viewPicture . f)
+
+linkAudio :: Call => (Time -> Int -> IO (V.Vector Stereo)) -> IO ()
+linkAudio f = do
+  g <- readIORef $ coreAudio given
+  writeIORef (coreAudio given) $ \dt n -> liftA2 (V.zipWith (+)) (f dt n) (g dt n)
+
+linkKeyboard :: Call => (Chatter Key -> IO ()) -> IO ()
+linkKeyboard f = do
+  g <- readIORef $ coreKeyboard given
+  writeIORef (coreKeyboard given) $ \k -> f k >> g k
+
+linkMouse :: Call => (MouseEvent -> IO ()) -> IO ()
+linkMouse f = do
+  g <- readIORef $ coreMouse given
+  writeIORef (coreMouse given) $ \k -> f k >> g k
+
+linkGamepad :: Call => (GamepadEvent -> IO ()) -> IO ()
+linkGamepad f = do
+  g <- readIORef $ coreJoypad given
+  writeIORef (coreJoypad given) $ \k -> f k >> g k
+
+data Foundation = Foundation
+  { sampleRate :: Float
+  , coreGraphic :: IORef (Time -> IO Sight)
+  , coreAudio :: IORef (Time -> Int -> IO (V.Vector (V2 Float)))
+  , coreKeyboard :: IORef (Chatter Key -> IO ())
+  , coreMouse :: IORef (MouseEvent -> IO ())
+  , coreJoypad :: IORef (GamepadEvent -> IO ())
+  , theTime :: MVar Time
+  , theSystem :: G.System
+  , targetFPS :: IORef Float
+  , textures :: IORef (IM.IntMap G.Texture)
+  , theEnd :: MVar ()
+  , theGamepadButtons :: IORef (IM.IntMap (String, IM.IntMap Bool))
+  , slowdown :: IORef (Map.Map Time Time)
+  }
+
+runCall :: WindowMode -> Box V2 Float -> (Call => IO a) -> IO (Maybe a)
+runCall mode box m = do
+  sys <- G.beginGLFW (mode == FullScreen) (mode == Resizable) box
+  fd <- Foundation
+    <$> pure 44100 -- FIX THIS
+    <*> newIORef (const $ return mempty)
+    <*> newIORef (\_ n -> return $ V.replicate n zero)
+    <*> newIORef (const $ return ())
+    <*> newIORef (const $ return ())
+    <*> newIORef (const $ return ())
+    <*> newMVar 0
+    <*> pure sys
+    <*> newIORef 60
+    <*> newIORef IM.empty
+    <*> newEmptyMVar
+    <*> newIORef IM.empty
+    <*> newIORef Map.empty
+  let win = G.theWindow sys
+  give fd $ do
+    GLFW.setKeyCallback win $ Just keyCallback
+    GLFW.setMouseButtonCallback win $ Just mouseButtonCallback
+    GLFW.setCursorPosCallback win $ Just cursorPosCallback
+    GLFW.setScrollCallback win $ Just scrollCallback
+  GL.UniformLocation loc <- GL.get $ GL.uniformLocation (G.theProgram sys) "color"
+  with (V4 1 1 1 1 :: V4 Float) $ \ptr -> GL.glUniform4fv loc 1 (castPtr ptr)
+
+  print =<< GLFW.getWindowClientAPI win
+  putStr "OpenGL Version: "
+  cv0 <- GLFW.getWindowContextVersionMajor    win
+  cv1 <- GLFW.getWindowContextVersionMinor    win
+  cv2 <- GLFW.getWindowContextVersionRevision win
+  putStrLn $ show cv0 ++ "." ++ show cv1 ++ "." ++ show cv2
+  print =<< GLFW.getWindowContextRobustness win
+  putStr "Forward compat: "
+  print =<< GLFW.getWindowOpenGLForwardCompat win
+  putStr "Debug context: "
+  print =<< GLFW.getWindowOpenGLDebugContext win
+  print =<< GLFW.getWindowOpenGLProfile win
+
+  ref <- newEmptyMVar
+  _ <- flip forkFinally (either throwIO (putMVar ref)) (give fd m)
+  give fd $ PA.with 44100 512 audioProcess $ liftIO $ do
+    GLFW.setTime 0
+    runGraphic 0
+  G.endGLFW sys
+  tryTakeMVar ref
+
+stand :: Call => IO ()
+stand = takeMVar (theEnd given)
+
+wait :: Call => Time -> IO ()
+wait dt = do
+  t0 <- takeMVar (theTime given)
+  Just t <- GLFW.getTime
+  threadDelay $ floor $ (t0 - realToFrac t + dt) * 1000 * 1000
+  putMVar (theTime given) $ t0 + dt
+
+getTime :: Call => IO Time
+getTime = readMVar (theTime given)
+
+keyPress :: Call => Key -> IO Bool
+keyPress k = fmap (/=GLFW.KeyState'Released)
+  $ GLFW.getKey (G.theWindow $ theSystem given) (toEnum . fromEnum $ k)
+
+mousePosition :: Call => IO (V2 Float)
+mousePosition = do
+  (x, y) <- GLFW.getCursorPos (G.theWindow $ theSystem given)
+  return $ V2 (realToFrac x) (realToFrac y)
+
+hideCursor :: Call => IO ()
+hideCursor = GLFW.setCursorInputMode (G.theWindow $ theSystem given) GLFW.CursorInputMode'Hidden
+
+disableCursor :: Call => IO ()
+disableCursor = GLFW.setCursorInputMode (G.theWindow $ theSystem given) GLFW.CursorInputMode'Disabled
+
+enableCursor :: Call => IO ()
+enableCursor = GLFW.setCursorInputMode (G.theWindow $ theSystem given) GLFW.CursorInputMode'Normal
+
+mouseButton :: Int -> Call => IO Bool
+mouseButton b = fmap (/=GLFW.MouseButtonState'Released)
+  $ GLFW.getMouseButton (G.theWindow $ theSystem given) (toEnum b)
+
+getGamepads :: Call => IO [Gamepad]
+getGamepads = fmap catMaybes $ forM [(GLFW.Joystick'1)..]
+  $ \j -> fmap (Gamepad (fromEnum j)) <$> GLFW.getJoystickName j
+
+gamepadAxes :: Call => Gamepad -> IO [Float]
+gamepadAxes (Gamepad i _) = maybe [] (map realToFrac) <$> GLFW.getJoystickAxes (toEnum i)
+
+gamepadButtons :: Call => Gamepad -> IO [Bool]
+gamepadButtons (Gamepad i _) = maybe [] (map (==GLFW.JoystickButtonState'Pressed)) <$> GLFW.getJoystickButtons (toEnum i)
+
+clearColor :: Call => V4 Float -> IO ()
+clearColor (V4 r g b a) = liftIO $ GL.clearColor $= GL.Color4 (realToFrac r) (realToFrac g) (realToFrac b) (realToFrac a)
+
+setBoundingBox :: Call => Box V2 Float -> IO ()
+setBoundingBox box@(Box (V2 x0 y0) (V2 x1 y1)) = do
+  GLFW.setWindowSize (G.theWindow $ theSystem given) (floor (x1 - x0)) (floor (y1 - y0))
+  writeIORef (G.refRegion $ theSystem given) box
+
+getBoundingBox :: Call => IO (Box V2 Float)
+getBoundingBox = readIORef (G.refRegion $ theSystem given)
+
+takeScreenshot :: Call => IO Bitmap
+takeScreenshot = G.screenshot (theSystem given) >>= liftImage'
+
+setTitle :: Call => String -> IO ()
+setTitle str = GLFW.setWindowTitle (G.theWindow $ theSystem given) str
+
+pollGamepad :: Call => IO ()
+pollGamepad = do
+  m <- readIORef (coreJoypad given)
+  ps <- IM.fromList <$> map (\p@(Gamepad i _) -> (i, p)) <$> getGamepads
+  bs0 <- readIORef (theGamepadButtons given)
+
+  bs0' <- forM (IM.toList $ ps IM.\\ bs0) $ \(i, p@(Gamepad _ s)) -> do
+    m $ PadConnection $ Up p
+    return (i, (s, IM.empty))
+
+  bs0_ <- forM (IM.toList $ bs0 IM.\\ ps) $ \(i, (s, _)) -> do
+    m $ PadConnection $ Down $ Gamepad i s
+    return (i, ())
+
+  let bs1 = bs0 `IM.union` IM.fromList bs0' IM.\\ IM.fromList bs0_
+
+  ls <- forM (IM.toList ps) $ \(j, p@(Gamepad _ s)) -> do
+    bs <- zip [0..] <$> gamepadButtons p
+    forM_ bs $ \(i, v) -> case (v, maybe False id (bs1 ^? ix j . _2 . ix i)) of
+        (False, True) -> m $ PadButton p (Up i)
+        (True, False) -> m $ PadButton p (Down i)
+        _ -> return ()
+    return (j, (s, IM.fromList bs))
+
+  writeIORef (theGamepadButtons given) $ foldr (uncurry IM.insert) bs1 ls
+
+getSlowdown :: Call => IO Float
+getSlowdown = do
+  m <- readIORef (slowdown given)
+  Just t0 <- GLFW.getTime
+  return $ F.sum m
+
+runGraphic :: Call => Time -> IO ()
+runGraphic t0 = do
+  pollGamepad
+  fps <- readIORef (targetFPS given)
+  G.beginFrame (theSystem given)
+  m <- readIORef (coreGraphic given)
+  pic <- m (1/fps) -- is it appropriate?
+  drawSight pic
+  b <- G.endFrame (theSystem given)
+
+  Just t <- fmap (fmap realToFrac) $ GLFW.getTime
+
+  case t0 + 1/fps - realToFrac t of
+    dt | dt > 0 -> threadDelay $ floor $ dt * 1000 * 1000
+       | otherwise -> modifyIORef' (slowdown given) $ \m -> m
+        & at t ?~ negate dt
+        & Map.split (t - 1)
+        & snd
+
+  tryTakeMVar (theEnd given) >>= \case
+      Just _ -> return ()
+      _ | b -> putMVar (theEnd given) ()
+        | otherwise -> runGraphic (max t (t0 + 1/fps))
+
+audioProcess :: Call => Int -> IO (V.Vector Stereo)
+audioProcess n = do
+  let dt = fromIntegral n / sampleRate given
+  m <- readIORef (coreAudio given)
+  m dt n
+
+keyCallback :: Call => GLFW.KeyCallback
+keyCallback _ k _ st _ = do
+  m <- readIORef (coreKeyboard given)
+  m $ case st of
+    GLFW.KeyState'Released -> Up (toEnum . fromEnum $ k :: Key)
+    _ -> Down (toEnum . fromEnum $ k :: Key)
+
+mouseButtonCallback :: Call => GLFW.MouseButtonCallback
+mouseButtonCallback _ btn st _ = do
+  m <- readIORef (coreMouse given)
+  m $ case st of
+    GLFW.MouseButtonState'Released -> Button $ Up (fromEnum btn)
+    _ -> Button $ Down (fromEnum btn)
+
+cursorPosCallback :: Call => GLFW.CursorPosCallback
+cursorPosCallback _ x y = do
+  m <- readIORef (coreMouse given)
+  m $ Cursor $ fmap realToFrac $ V2 x y
+
+scrollCallback :: Call => GLFW.ScrollCallback
+scrollCallback _ x y = do
+  m <- readIORef (coreMouse given)
+  m $ Scroll $ fmap realToFrac $ V2 x y
+
+fetchTexture :: Call => C.Image C.PixelRGBA8 -> Int -> IO G.Texture
+fetchTexture bmp h = do
+  st <- readIORef (textures given)
+  case IM.lookup h st of
+    Just t -> return t
+    Nothing -> do
+      t <- G.installTexture bmp
+      writeIORef (textures given) $ IM.insert h t st
+      return t
+
+drawScene :: Call => Box V2 Float -> M44 Float -> Bool -> Scene -> IO ()
+drawScene (fmap round -> Box (V2 x0 y0) (V2 x1 y1)) proj _ (Scene s) = do
+  GL.viewport $= (GL.Position x0 y0, GL.Size (x1 - x0) (y1 - y0))
+
+  GL.currentProgram $= Just shaderProg
+  GL.UniformLocation loc <- GL.get (GL.uniformLocation shaderProg "projection")
+  with proj $ \ptr -> GL.glUniformMatrix4fv loc 1 1 $ castPtr ptr
+  GL.UniformLocation locTextureMix <- GL.get $ GL.uniformLocation shaderProg "textureMix"
+  GL.UniformLocation locMats <- GL.get $ GL.uniformLocation shaderProg "matrices"
+  GL.UniformLocation locLevel <- GL.get $ GL.uniformLocation shaderProg "level"
+  GL.UniformLocation locDiffuse <- GL.get $ GL.uniformLocation shaderProg "diffuse"
+  with (V4 1 1 (1 :: Float) 1) $ \ptr -> GL.glUniform4fv locDiffuse 1 (castPtr ptr)
+  s (pure $ return ()) (liftA2 (>>)) (prim locTextureMix) (fx locDiffuse) (trans locMats locLevel) (V4 1 1 1 1, 0)
+  where
+    shaderProg = G.theProgram $ theSystem given
+    prim locTextureMix Blank mode vs _ = do
+      GL.glUniform1f locTextureMix 0
+      V.unsafeWith vs $ \v -> GL.bufferData GL.ArrayBuffer $=
+        (fromIntegral $ V.length vs * sizeOf (undefined :: Vertex), v, GL.StaticDraw)
+      GL.drawArrays (convPrimitiveMode mode) 0 $ fromIntegral $ V.length vs
+
+    prim locTextureMix (Bitmap bmp _ h) mode vs _ = do
+      GL.glUniform1f locTextureMix 1
+      (tex, _, _) <- fetchTexture bmp h
+      GL.activeTexture $= GL.TextureUnit 0
+      GL.textureBinding GL.Texture2D $= Just tex
+      GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear')
+      V.unsafeWith vs $ \v -> GL.bufferData GL.ArrayBuffer $=
+        (fromIntegral $ V.length vs * sizeOf (undefined :: Vertex), v, GL.StaticDraw)
+      GL.drawArrays (convPrimitiveMode mode) 0 $ fromIntegral $ V.length vs
+
+    trans locMats locLevel f m (color0, n) = do
+      with f $ \ptr -> GL.glUniformMatrix4fv (locMats + n) 1 1 (castPtr ptr)
+      GL.glUniform1i locLevel (unsafeCoerce $ n + 1)
+      () <- m (color0, n + 1)
+      GL.glUniform1i locLevel (unsafeCoerce n)
+
+    fx locDiffuse (EmbedIO m) c = m >>= ($ c)
+
+    fx locDiffuse (Diffuse col m) (color0, n) = do
+      let c = col * color0
+      with c $ \ptr -> GL.glUniform4fv locDiffuse 1 (castPtr ptr)
+      m (c, n)
+      with color0 $ \ptr -> GL.glUniform4fv locDiffuse 1 (castPtr ptr)
+
+drawSight :: Call => Sight -> IO ()
+drawSight (Sight s) = do
+  b <- readIORef $ G.refRegion $ theSystem given
+  s b (return ()) (>>) drawScene
+
+convPrimitiveMode :: U.PrimitiveMode -> GL.PrimitiveMode
+convPrimitiveMode U.LineStrip = GL.LineStrip
+convPrimitiveMode U.TriangleFan = GL.TriangleFan
+convPrimitiveMode U.TriangleStrip = GL.TriangleStrip
+convPrimitiveMode U.LineLoop = GL.LineLoop
diff --git a/src/Call/Data/Bitmap.hs b/src/Call/Data/Bitmap.hs
deleted file mode 100644
--- a/src/Call/Data/Bitmap.hs
+++ /dev/null
@@ -1,101 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Call.Data.Bitmap
--- Copyright   :  (c) Fumiaki Kinoshita 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable
---
------------------------------------------------------------------------------
-module Call.Data.Bitmap (
-  Bitmap(Blank, Bitmap)
-  ,image
-  ,offset
-  ,hash
-  ,liftImage
-  ,liftImage'
-  ,size
-  ,clip
-  ,bbox
-  ,readFile
-  ,writeFile
-  ) where
-import Prelude hiding (readFile, writeFile)
-import qualified Codec.Picture as C
-import qualified Codec.Picture.Types as C
-import qualified Codec.Picture.RGBA8 as C
-import Control.Monad.IO.Class
-import qualified Data.BoundingBox as B
-import Linear
-import System.Random
-import Control.Applicative
-import qualified Data.Hashable as H
-import qualified Data.Vector.Storable as V
-import Data.Monoid
-import Control.Lens
-import Control.Monad.ST
-
-data Bitmap = Blank | Bitmap { _image :: !(C.Image C.PixelRGBA8), _offset :: !(V2 Int), _hash :: !Int }
-
-image :: Traversal' Bitmap (C.Image C.PixelRGBA8)
-image _ Blank = pure Blank
-image f (Bitmap i o h) = f i <&> \i' -> Bitmap i' o h
-
-offset :: Traversal' Bitmap (V2 Int)
-offset _ Blank = pure Blank
-offset f (Bitmap i o h) = f o <&> \o' -> Bitmap i o' h
-
-hash :: Traversal' Bitmap Int
-hash _ Blank = pure Blank
-hash f (Bitmap i o h) = f h <&> \h' -> Bitmap i o h'
-
--- | `mappend` stitches the right operand to the left
-instance Monoid Bitmap where
-  mempty = Blank
-  mappend base@(Bitmap b (V2 x0 y0) h0) lay@(Bitmap l (V2 x1 y1) h1) = runST $ do
-    let box = B.union (bbox base) (bbox lay)
-    let V2 w h = box ^. B.size 0
-    img <- C.createMutableImage w h (C.PixelRGBA8 0 0 0 0) >>= C.unsafeFreezeImage
-    let ox = max 0 (x0 - x1)
-    let oy = max 0 (y0 - y1)
-    return $ Bitmap
-      (C.patchImage (C.patchImage img (ox, oy) b) (max 0 (x1 - x0), max 0 (y1 - y0)) l)
-      (V2 (x0 + ox) (y0 + oy))
-      (H.hash (h0, h1))
-  mappend Blank b = b
-  mappend b Blank = b
-
-clip :: Bitmap -> B.Box V2 Int -> Bitmap
-clip (Bitmap b (V2 ox oy) k) (B.Box (V2 x0 y0) (V2 x1 y1)) = Bitmap
-  (C.trimImage b (x1 - x0, y1 - y0) (x0 - ox, y0 - oy))
-  (V2 ox oy)
-  (H.hash (x0, y0, x1, y1, k))
-
-clip Blank _ = Blank
-
-bbox :: Bitmap -> B.Box V2 Int
-bbox (Bitmap (C.Image w h _) (V2 x y) _) = B.Box (V2 x y) (V2 (x+w) (y+h))
-bbox Blank = B.Box zero zero
-
-size :: Bitmap -> V2 Int
-size (Bitmap (C.Image w h _) _ _) = V2 w h
-size Blank = zero
-
-liftImage :: C.Image C.PixelRGBA8 -> Bitmap
-liftImage b@(C.Image _ _ r) = Bitmap b zero (V.foldl H.hashWithSalt 0 r)
-
-liftImage' :: MonadIO m => C.Image C.PixelRGBA8 -> m Bitmap
-liftImage' b = liftIO $ Bitmap b zero <$> randomIO
-
--- | Load an image file.
-readFile :: MonadIO m => FilePath -> m Bitmap
-readFile path = liftIO $ Bitmap <$> C.readImageRGBA8 path <*> pure zero <*> randomIO
-
--- | Save 'Bitmap' into a file.
-writeFile :: MonadIO m => FilePath -> Bitmap -> m ()
-writeFile path (Bitmap p _ _) = liftIO $ C.writePng path p
-writeFile _ Blank = fail "Blank bitmap"
-
diff --git a/src/Call/Data/Font.hs b/src/Call/Data/Font.hs
deleted file mode 100644
--- a/src/Call/Data/Font.hs
+++ /dev/null
@@ -1,120 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Call.Data.Font
--- Copyright   :  (c) Fumiaki Kinoshita 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable
---
--- Font rendering
---
------------------------------------------------------------------------------
-module Call.Data.Font 
-  ( Font
-  , readFont
-  , defaultFont
-  , fontBoundingBox
-  , metricsAscent
-  , metricsDescent
-  , renderChar
-  ) where
-
-import Control.Applicative
-import Control.Monad.IO.Class
-import Control.Monad
-import Data.BoundingBox
-import qualified Data.Vector.Storable as V
-import Linear
-import Call.Data.Bitmap
-import Graphics.Rendering.FreeType.Internal
-import qualified Graphics.Rendering.FreeType.Internal.GlyphSlot as GS
-import qualified Graphics.Rendering.FreeType.Internal.Vector as V
-import Graphics.Rendering.FreeType.Internal.Bitmap as B
-import Graphics.Rendering.FreeType.Internal.PrimitiveTypes as PT
-import Graphics.Rendering.FreeType.Internal.Face as F
-import Graphics.Rendering.FreeType.Internal.Library as L
-import Graphics.Rendering.FreeType.Internal.BBox as BB
-import Foreign.Marshal.Alloc
-import Foreign.C.Types
-import Foreign.C.String
-import Foreign.Storable
-import Foreign.ForeignPtr
-import Foreign.Ptr
-import System.IO.Unsafe
-import Codec.Picture
-import Codec.Picture.RGBA8
-import Paths_call
-
--- | Font object
-data Font = Font FT_Face (Float, Float) (Box V2 Float)
-
-defaultFont :: Font
-defaultFont = unsafePerformIO $ do
-  path <- getDataFileName "data/VL-PGothic-Regular.ttf"
-  readFont path
-
--- | Create a 'Font' from the given file.
-readFont :: MonadIO m => FilePath -> m Font
-readFont path = liftIO $ alloca $ \p -> do
-    runFreeType $ withCString path $ \str -> ft_New_Face freeType str 0 p
-    f <- peek p
-    b <- peek (F.bbox f)
-    asc <- peek (ascender f)
-    desc <- peek (descender f)
-    u <- fromIntegral <$> peek (units_per_EM f)
-    let box = fmap ((/u).fromIntegral) $ Box
-            (V2 (xMin b) (yMin b))
-            (V2 (xMax b) (yMax b))
-    return $ Font f (fromIntegral asc/u, fromIntegral desc/u) box
-
--- | Get the font's metrics.
-metricsAscent :: Font -> Float
-metricsAscent (Font _ (a, _) _) = a
-
--- | Get the font's metrics.
-metricsDescent :: Font -> Float
-metricsDescent (Font _ (_, d) _) = d
-
--- | Get the font's bounding box.
-fontBoundingBox :: Font -> Box V2 Float
-fontBoundingBox (Font _ _ b) = b
-
-runFreeType :: IO CInt -> IO ()
-runFreeType m = do
-    r <- m
-    unless (r == 0) $ fail $ "FreeType Error:" Prelude.++ show r
-
-freeType :: FT_Library
-freeType = unsafePerformIO $ alloca $ \p -> do
-  runFreeType $ ft_Init_FreeType p
-  peek p
-
-renderChar :: Font -> Float -> Char -> IO (Bitmap, V2 Float, V2 Float)
-renderChar (Font face _ _) pixel ch = do
-  let dpi = 300
-
-  runFreeType $ ft_Set_Char_Size face 0 (floor $ pixel * 72 / fromIntegral dpi * 64) dpi dpi
-  
-  ix <- ft_Get_Char_Index face (fromIntegral $ fromEnum ch)
-  runFreeType $ ft_Load_Glyph face ix ft_LOAD_DEFAULT
-
-  slot <- peek $ glyph face
-  runFreeType $ ft_Render_Glyph slot ft_RENDER_MODE_NORMAL
-
-  bmp <- peek $ GS.bitmap slot
-  left <- fmap fromIntegral $ peek $ GS.bitmap_left slot
-  top <- fmap fromIntegral $ peek $ GS.bitmap_top slot
-
-  let h = fromIntegral $ B.rows bmp
-      w = fromIntegral $ B.width bmp
-  
-  fptr <- newForeignPtr_ $ castPtr $ buffer bmp
-
-  adv <- peek $ GS.advance slot
-  b <- liftImage' $ fromColorAndOpacity (PixelRGB8 255 255 255)
-        $ Image w h $ V.unsafeFromForeignPtr0 fptr $ h * w
-  return (b
-    , V2 (left + fromIntegral w / 2) (-top + fromIntegral h / 2)
-    , V2 (fromIntegral (V.x adv) / 64) 0)
diff --git a/src/Call/Data/Wave.hs b/src/Call/Data/Wave.hs
deleted file mode 100644
--- a/src/Call/Data/Wave.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# LANGUAGE BangPatterns, DeriveFunctor #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Call.Data.Wave
--- Copyright   :  (c) Fumiaki Kinoshita 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable
---
------------------------------------------------------------------------------
-module Call.Data.Wave (
-  Source(..),
-  Sample(..),
-  Stereo,
-  readWAVE
-) where
-
-import Data.WAVE
-import Linear
-import Call.Types
-import Control.Monad.IO.Class
-import qualified Data.Vector.Unboxed as V
-import GHC.Float
-import Data.Monoid
-import Control.Applicative
-
-newtype Source a = Source (Time -> a) deriving Functor
-
-instance Applicative Source where
-  pure a = Source (const a)
-  Source f <*> Source g = Source (f <*> g)
-
-instance Num a => Monoid (Source a) where
-  mempty = pure 0
-  mappend = liftA2 (+)
-
-readWAVE :: MonadIO m => FilePath -> m (Sample Stereo)
-readWAVE path = liftIO $ do
-  WAVE h ss <- getWAVEFile path
-  let vec = V.fromList (map fr ss)
-      rate = fromIntegral (waveFrameRate h)
-      !dur = fromIntegral (V.length vec) / rate
-      sample t
-        | t < 0 || t >= dur - (1/rate) = zero
-        | otherwise = vec V.! round (t * rate)
-  return $ Sample dur (Source sample)
-  where
-    fr [a, b] = V2 (double2Float $ sampleToDouble a) (double2Float $ sampleToDouble b)
-    fr _ = zero
-
-data Sample a = Sample { sampleLength :: Time ,sampleSource :: Source a}
-
--- TODO: Lazy processing
diff --git a/src/Call/Internal/GLFW.hs b/src/Call/Internal/GLFW.hs
--- a/src/Call/Internal/GLFW.hs
+++ b/src/Call/Internal/GLFW.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Call.Internal.GLFW
@@ -15,14 +15,14 @@
 import Control.Applicative
 import Control.Lens
 import Data.IORef
-import Call.Types
 import Data.BoundingBox
+import Data.Graphics.Class
+import Data.Graphics.Vertex
 import Control.Monad
 import Graphics.Rendering.OpenGL.GL.StateVar
 import Linear
 import qualified Graphics.Rendering.OpenGL.Raw as GL
 import qualified Graphics.Rendering.OpenGL.GL as GL
-import qualified Graphics.Rendering.OpenGL.GLU.Errors as GL
 import qualified Graphics.UI.GLFW as GLFW
 import Unsafe.Coerce
 import qualified Data.Vector.Storable as V
@@ -75,24 +75,22 @@
   GLFW.pollEvents
   GLFW.windowShouldClose (theWindow sys)
 
-beginGLFW :: WindowMode -> Box V2 Float -> IO System
-beginGLFW mode bbox@(Box (V2 x0 y0) (V2 x1 y1)) = do
+beginGLFW :: Bool -> Bool -> Box V2 Float -> IO System
+beginGLFW full resiz bbox@(Box (V2 x0 y0) (V2 x1 y1)) = do
   Encoding.setForeignEncoding Encoding.utf8
   let title = "call"
       ww = floor $ x1 - x0
       wh = floor $ y1 - y0
   () <- unlessM GLFW.init (fail "Failed to initialize")
 
-  mon <- case mode of
-    FullScreen -> GLFW.getPrimaryMonitor
-    _ -> return Nothing
+  mon <- if full then GLFW.getPrimaryMonitor else return Nothing
 
   GLFW.windowHint $ GLFW.WindowHint'ContextVersionMajor 3
   GLFW.windowHint $ GLFW.WindowHint'ContextVersionMinor 2
   GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core
   GLFW.windowHint $ GLFW.WindowHint'OpenGLForwardCompat True
 
-  GLFW.windowHint $ GLFW.WindowHint'Resizable $ mode == Resizable
+  GLFW.windowHint $ GLFW.WindowHint'Resizable resiz
   win <- GLFW.createWindow ww wh title mon Nothing >>= maybe (fail "Failed to create a window") return
   GLFW.makeContextCurrent (Just win)
   prog <- initializeGL
@@ -172,7 +170,7 @@
 
   GL.lineSmooth $= GL.Enabled
   GL.textureFunction $= GL.Combine
-  GL.clearColor $= GL.Color4 1 1 1 1
+  GL.clearColor $= GL.Color4 0 0 0 1
   GL.UniformLocation loc0 <- GL.get $ GL.uniformLocation shaderProg "useEnv"
   GL.glUniform1i loc0 0
   GL.UniformLocation loc1 <- GL.get $ GL.uniformLocation shaderProg "tex"
@@ -183,6 +181,7 @@
   GL.glUniform1f loc3 0
   GL.UniformLocation loc4 <- GL.get $ GL.uniformLocation shaderProg "envMul"
   GL.glUniform1f loc4 0
+  GL.cullFace $= Just GL.Back
 
   return shaderProg
 
diff --git a/src/Call/Sight.hs b/src/Call/Sight.hs
deleted file mode 100644
--- a/src/Call/Sight.hs
+++ /dev/null
@@ -1,183 +0,0 @@
-{-# LANGUAGE TypeFamilies
-  , FlexibleContexts
-  , BangPatterns
-  , DeriveFunctor
-  , Rank2Types
-  , FlexibleInstances
-  , UndecidableInstances
-  , ViewPatterns
-  , ScopedTypeVariables
-  , GeneralizedNewtypeDeriving #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Call.Scene
--- Copyright   :  (c) Fumiaki Kinoshita 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable
---
------------------------------------------------------------------------------
-module Call.Sight (Affine(..)
-    , Figure(..)
-    , Picture(..)
-    , opacity
-    , bitmap
-    , toward
-    , Scene(..)
-    , transformScene
-    , vertices
-    , Sight(..)
-    , viewPicture
-    , viewScene
-    , fromPerspective
-    , VFX(..)
-    , applyVFX
-    , GL.PrimitiveMode(..)
-    ) where
-import qualified Call.Data.Bitmap as B
-import qualified Data.BoundingBox as X
-import Data.Monoid
-import Linear
-import qualified Data.Vector.Storable as V
-import Control.Lens
-import qualified Graphics.Rendering.OpenGL.GL as GL
-import Data.Color
-import Call.Types
-
-class Affine a where
-  type Vec a :: *
-  type Normal a :: *
-  rotateOn :: Normal a -> a -> a
-  scale :: Vec a -> a -> a
-  translate :: Vec a -> a -> a
-
-class Affine a => Figure a where
-  primitive :: GL.PrimitiveMode -> [Vec a] -> a
-  color :: RGBA Float -> a -> a
-  line :: [Vec a] -> a
-  polygon :: [Vec a] -> a
-  polygonOutline :: [Vec a] -> a
-  circle :: Normal a -> a
-  circleOutline :: Normal a -> a
-
-opacity :: Figure a => Float -> a -> a
-opacity p = color (V4 1 1 1 p)
-
-bitmap :: B.Bitmap -> Picture
-bitmap bmp = Picture $ Scene
-  $ \_ _ f _ _ -> f bmp GL.TriangleStrip
-    (V.fromList [V3 (-w/2) (-h/2) 0 `positionUV` V2 0 0
-        , V3 (w/2) (-h/2) 0 `positionUV` V2 1 0
-        , V3 (-w/2) (h/2) 0 `positionUV` V2 0 1
-        , V3 (w/2) (h/2) 0 `positionUV` V2 1 1]) where
-  V2 w h = fmap fromIntegral $ B.size bmp
-
-toward :: Vec3 -> Picture -> Scene
-toward n@((^/norm n) -> V3 x y z) (Picture s) = transformScene
-  (m33_to_m44 $ fromQuaternion $ axisAngle (V3 (-y) x 0) $ acos $ z / norm n)
-  s
-
-newtype Scene = Scene { unScene :: forall r.
-  r
-  -> (r -> r -> r)
-  -> (B.Bitmap -> GL.PrimitiveMode -> V.Vector Vertex -> r)
-  -> (VFX r -> r)
-  -> (M44 Float -> r -> r)
-  -> r
-  }
-
-data VFX r = SphericalAdd Bitmap r
-  | SphericalMultiply Bitmap r
-  | Diffuse (V4 Float) r
---  | Specular (V3 Float) r
---  | Ambient (V3 Float) r
---  | NormalMap Bitmap r
-  | EmbedIO (IO r)
-  deriving Functor
-
-instance Affine Scene where
-  type Vec Scene = V3 Float
-  type Normal Scene = V3 Float
-  rotateOn v = transformScene $ m33_to_m44 $ fromQuaternion $ axisAngle v (norm v)
-  scale (V3 x y z) = transformScene $ V4
-    (V4 x 0 0 0)
-    (V4 0 y 0 0)
-    (V4 0 0 z 0)
-    (V4 0 0 0 1)
-  translate v = transformScene $ translation .~ v $ eye4
-
-instance Figure Scene where
-  primitive m vs = Scene $ \_ _ f _ _ -> f Blank m (V.fromList $ map positionOnly vs)
-  color col (Scene s) = Scene $ \e a f b t -> b (Diffuse col (s e a f b t))
-  line = primitive GL.LineStrip
-  polygon = primitive GL.TriangleFan
-  polygonOutline = primitive GL.LineLoop
-  circle v = toward v $ circle $ norm v
-  circleOutline v = toward v $ circleOutline $ norm v
-
-unit_circle :: Int -> [V2 Float]
-unit_circle n = map angle [0,2*pi/fromIntegral n..2*pi]
-
-instance Monoid Scene where
-  mempty = Scene $ \e _ _ _ _ -> e
-  mappend (Scene x) (Scene y) = Scene $ \e a f b t -> a (x e a f b t) (y e a f b t)
-
-v2ToV3 :: Num a => V2 a -> V3 a
-v2ToV3 (V2 x y) = V3 x y 0
-
-vertices :: B.Bitmap -> GL.PrimitiveMode -> V.Vector Vertex -> Scene
-vertices b m v = Scene $ \_ _ f _ _ -> f b m v
-
-transformScene :: M44 Float -> Scene -> Scene
-transformScene m (Scene pic) = Scene $ \e a f b t -> t m (pic e a f b t)
-
-applyVFX :: VFX Scene -> Scene
-applyVFX vf = Scene $ \e a f b t -> b $ fmap (\(Scene s) -> s e a f b t) vf
-
-newtype Picture = Picture { unPicture :: Scene } deriving Monoid
-
-instance Affine Picture where
-  type Vec Picture = V2 Float
-  type Normal Picture = Float
-  rotateOn t (Picture s) = Picture (transformScene m s) where
-    m = V4 (V4 (cos t) (-sin t) 0 0) (V4 (sin t) (cos t) 0 0) (V4 0 0 1 0) (V4 0 0 0 1)
-  translate (V2 x y) (Picture s) = Picture $ transformScene (translation .~ V3 x y 0 $ eye4) s
-  scale (V2 x y) (Picture s) = Picture (transformScene m s) where
-    m = V4 (V4 x 0 0 0) (V4 0 y 0 0) (V4 0 0 1 0) (V4 0 0 0 1)
-
-instance Figure Picture where
-  primitive m v = Picture $ primitive m $ map v2ToV3 v
-  color col (Picture s) = Picture (color col s)
-  line = primitive GL.LineStrip
-  polygon = primitive GL.TriangleFan
-  polygonOutline = primitive GL.LineLoop
-  circle r = polygon $ map (^*r) $ unit_circle 33
-  circleOutline r = polygonOutline $ map (^*r) $ unit_circle 33
-
-newtype Sight = Sight { unSight
-  :: forall r.
-  X.Box V2 Float
-  -> r
-  -> (r -> r -> r)
-  -> (X.Box V2 Float -> M44 Float -> Bool -> Scene -> r)
-  -> r
-  }
-
-instance Monoid Sight where
-  mempty = Sight $ \_ e _ _ -> e
-  mappend (Sight x) (Sight y) = Sight $ \b e a f -> a (x b e a f) (y b e a f)
-
-viewPicture :: Picture -> Sight
-viewPicture (Picture s) = Sight $ \box@(X.Box (V2 x0 y0) (V2 x1 y1)) _ _ f -> f box (ortho x0 x1 y1 y0 (-1) 1) False s
-
-viewScene :: Float -- ^ FOV
-  -> Float -- ^ Near plane
-  -> Float -- ^ Far plane
-  -> Scene -- ^ The scene
-  -> Sight
-viewScene fov near far = fromPerspective $ \box -> perspective fov (let V2 w h = box ^. X.size 0 in w/h) near far
-
-fromPerspective :: (X.Box V2 Float -> M44 Float) -> Scene -> Sight
-fromPerspective mat s = Sight $ \box _ _ f -> f box (mat box) True s
diff --git a/src/Call/System.hs b/src/Call/System.hs
deleted file mode 100644
--- a/src/Call/System.hs
+++ /dev/null
@@ -1,436 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Call.System
--- Copyright   :  (c) Fumiaki Kinoshita 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable
---
------------------------------------------------------------------------------
-module Call.System (
-  -- * The system
-  System
-  , runSystem
-  , forkSystem
-  -- * Time
-  , stand
-  , wait
-  , getTime
-  , setFPS
-  -- * Raw input
-  , keyPress
-  , mousePosition
-  , mouseButton
-  , enableCursor
-  , hideCursor
-  , disableCursor
-  , getGamepads
-  , gamepadButtons
-  , gamepadAxes
-  -- * Component
-  , linkGraphic
-  , linkPicture
-  , linkAudio
-  , linkKeyboard
-  , linkMouse
-  , linkGamepad
-  -- * Others
-  , setTitle
-  , clearColor
-  , getBoundingBox
-  , setBoundingBox
-  , takeScreenshot
-  ) where
-
-import Call.Data.Bitmap
-import Call.Sight
-import Call.Types
-import Control.Applicative
-import Control.Concurrent
-import Control.Exception
-import Control.Lens
-import Control.Monad.Reader
-import Data.BoundingBox (Box(..))
-import Data.IORef
-import Data.Maybe
-import Data.Monoid
-import Foreign (castPtr, sizeOf, with)
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Linear
-import qualified Call.Internal.GLFW as G
-import qualified Call.Internal.PortAudio as PA
-import qualified Codec.Picture as C
-import qualified Data.IntMap.Strict as IM
-import qualified Data.Vector.Storable as V
-import qualified Graphics.Rendering.OpenGL.GL as GL
-import qualified Graphics.Rendering.OpenGL.Raw as GL
-import qualified Graphics.UI.GLFW as GLFW
-import Unsafe.Coerce
-
-setFPS :: Float -> System s ()
-setFPS f = mkSystem $ \fo -> writeIORef (targetFPS fo) f
-
-newtype System s a = System (ReaderT (Foundation s) IO a) deriving (Functor, Applicative, Monad)
-
-instance Affine a => Affine (System s a) where
-  type Vec (System s a) = Vec a
-  type Normal (System s a) = Normal a
-  translate t = fmap (translate t)
-  scale t = fmap (scale t)
-  rotateOn t = fmap (rotateOn t)
-
-instance Figure a => Figure (System s a) where
-  primitive p v = return $ primitive p v
-  color c = fmap (color c)
-  line = return . line
-  polygon = return . polygon
-  polygonOutline = return . polygonOutline
-  circle = return . circle
-  circleOutline = return . circleOutline
-
-instance Monoid a => Monoid (System s a) where
-  mempty = return mempty
-  mappend = liftA2 mappend
-
-unSystem :: Foundation s -> System s a -> IO a
-unSystem f m = unsafeCoerce m f
-
-mkSystem :: (Foundation s -> IO a) -> System s a
-mkSystem = unsafeCoerce
-
-forkSystem :: System s () -> System s ThreadId
-forkSystem m = mkSystem $ \fo -> forkIO (unSystem fo m)
-
-linkGraphic :: (Time -> System s Sight) -> System s ()
-linkGraphic f = mkSystem $ \fo -> do
-  g <- readIORef $ coreGraphic fo
-  writeIORef (coreGraphic fo) $ \dt -> liftA2 (<>) (f dt) (g dt)
-
-linkPicture :: (Time -> System s Picture) -> System s ()
-linkPicture f = linkGraphic (fmap viewPicture . f)
-
-linkAudio :: (Time -> Int -> System s (V.Vector Stereo)) -> System s ()
-linkAudio f = mkSystem $ \fo -> do
-  g <- readIORef $ coreAudio fo
-  writeIORef (coreAudio fo) $ \dt n -> liftA2 (V.zipWith (+)) (f dt n) (g dt n)
-
-linkKeyboard :: (Chatter Key -> System s ()) -> System s ()
-linkKeyboard f = mkSystem $ \fo -> do
-  g <- readIORef $ coreKeyboard fo
-  writeIORef (coreKeyboard fo) $ \k -> f k >> g k
-
-linkMouse :: (MouseEvent -> System s ()) -> System s ()
-linkMouse f = mkSystem $ \fo -> do
-  g <- readIORef $ coreMouse fo
-  writeIORef (coreMouse fo) $ \k -> f k >> g k
-
-linkGamepad :: (GamepadEvent -> System s ()) -> System s ()
-linkGamepad f = mkSystem $ \fo -> do
-  g <- readIORef $ coreJoypad fo
-  writeIORef (coreJoypad fo) $ \k -> f k >> g k
-
-data Foundation s = Foundation
-  { sampleRate :: Float
-  , coreGraphic :: IORef (Time -> System s Sight)
-  , coreAudio :: IORef (Time -> Int -> System s (V.Vector (V2 Float)))
-  , coreKeyboard :: IORef (Chatter Key -> System s ())
-  , coreMouse :: IORef (MouseEvent -> System s ())
-  , coreJoypad :: IORef (GamepadEvent -> System s ())
-  , theTime :: MVar Time
-  , theSystem :: G.System
-  , targetFPS :: IORef Float
-  , textures :: IORef (IM.IntMap G.Texture)
-  , theEnd :: MVar ()
-  , theGamepadButtons :: IORef (IM.IntMap (String, IM.IntMap Bool))
-  }
-
-runSystem :: WindowMode -> Box V2 Float -> (forall s. System s a) -> IO (Maybe a)
-runSystem mode box m = do
-  sys <- G.beginGLFW mode box
-  f <- Foundation
-    <$> pure 44100 -- FIX THIS
-    <*> newIORef (const $ return mempty)
-    <*> newIORef (\_ n -> return $ V.replicate n zero)
-    <*> newIORef (const $ return ())
-    <*> newIORef (const $ return ())
-    <*> newIORef (const $ return ())
-    <*> newMVar 0
-    <*> pure sys
-    <*> newIORef 60
-    <*> newIORef IM.empty
-    <*> newEmptyMVar
-    <*> newIORef IM.empty
-  let win = G.theWindow sys
-  GLFW.setKeyCallback win $ Just $ keyCallback f
-  GLFW.setMouseButtonCallback win $ Just $ mouseButtonCallback f
-  GLFW.setCursorPosCallback win $ Just $ cursorPosCallback f
-  GLFW.setScrollCallback win $ Just $ scrollCallback f
-  GL.UniformLocation loc <- GL.get $ GL.uniformLocation (G.theProgram sys) "color"
-  with (V4 1 1 1 1 :: V4 Float) $ \ptr -> GL.glUniform4fv loc 1 (castPtr ptr)
-
-  print =<< GLFW.getWindowClientAPI win
-  putStr "OpenGL Version: "
-  cv0 <- GLFW.getWindowContextVersionMajor    win
-  cv1 <- GLFW.getWindowContextVersionMinor    win
-  cv2 <- GLFW.getWindowContextVersionRevision win
-  putStrLn $ show cv0 ++ "." ++ show cv1 ++ "." ++ show cv2
-  print =<< GLFW.getWindowContextRobustness win
-  putStr "Forward compat: "
-  print =<< GLFW.getWindowOpenGLForwardCompat win
-  putStr "Debug context: "
-  print =<< GLFW.getWindowOpenGLDebugContext win
-  print =<< GLFW.getWindowOpenGLProfile win
-
-  ref <- newEmptyMVar
-  _ <- flip forkFinally (either throwIO (putMVar ref)) $ unSystem f m
-  PA.with 44100 512 (audioProcess f) $ liftIO $ do
-    GLFW.setTime 0
-    runGraphic f 0
-  G.endGLFW sys
-  tryTakeMVar ref
-
-stand :: System s ()
-stand = mkSystem $ \fo -> takeMVar (theEnd fo)
-
-wait :: Time -> System s ()
-wait dt = mkSystem $ \fo -> do
-  t0 <- takeMVar (theTime fo)
-  Just t <- GLFW.getTime
-  threadDelay $ floor $ (t0 - realToFrac t + dt) * 1000 * 1000
-  putMVar (theTime fo) $ t0 + dt
-
-getTime :: System s Time
-getTime = mkSystem $ \fo -> readMVar (theTime fo)
-
-keyPress :: Key -> System s Bool
-keyPress k = mkSystem $ \fo -> fmap (/=GLFW.KeyState'Released)
-  $ GLFW.getKey (G.theWindow $ theSystem fo) (toEnum . fromEnum $ k)
-
-mousePosition :: System s (V2 Float)
-mousePosition = mkSystem $ \fo -> do
-  (x, y) <- GLFW.getCursorPos (G.theWindow $ theSystem fo)
-  return $ V2 (realToFrac x) (realToFrac y)
-
-hideCursor :: System s ()
-hideCursor = mkSystem $ \fo -> GLFW.setCursorInputMode (G.theWindow $ theSystem fo) GLFW.CursorInputMode'Hidden
-
-disableCursor :: System s ()
-disableCursor = mkSystem $ \fo -> GLFW.setCursorInputMode (G.theWindow $ theSystem fo) GLFW.CursorInputMode'Disabled
-
-enableCursor :: System s ()
-enableCursor = mkSystem $ \fo -> GLFW.setCursorInputMode (G.theWindow $ theSystem fo) GLFW.CursorInputMode'Normal
-
-mouseButton :: Int -> System s Bool
-mouseButton b = mkSystem $ \fo -> fmap (/=GLFW.MouseButtonState'Released)
-  $ GLFW.getMouseButton (G.theWindow $ theSystem fo) (toEnum b)
-
-getGamepads :: System s [Gamepad]
-getGamepads = mkSystem $ const $ fmap catMaybes $ forM [(GLFW.Joystick'1)..]
-  $ \j -> fmap (Gamepad (fromEnum j)) <$> GLFW.getJoystickName j
-
-gamepadAxes :: Gamepad -> System s [Float]
-gamepadAxes (Gamepad i _) = mkSystem $ const $ maybe [] (map realToFrac) <$> GLFW.getJoystickAxes (toEnum i)
-
-gamepadButtons :: Gamepad -> System s [Bool]
-gamepadButtons (Gamepad i _) = mkSystem $ const
-  $ maybe [] (map (==GLFW.JoystickButtonState'Pressed)) <$> GLFW.getJoystickButtons (toEnum i)
-
-clearColor :: V4 Float -> System s ()
-clearColor col = liftIO $ GL.clearColor $= unsafeCoerce col
-
-setBoundingBox :: Box V2 Float -> System s ()
-setBoundingBox box@(Box (V2 x0 y0) (V2 x1 y1)) = mkSystem $ \fo -> do
-  GLFW.setWindowSize (G.theWindow $ theSystem fo) (floor (x1 - x0)) (floor (y1 - y0))
-  writeIORef (G.refRegion $ theSystem fo) box
-
-getBoundingBox :: System s (Box V2 Float)
-getBoundingBox = mkSystem $ \fo -> readIORef (G.refRegion $ theSystem fo)
-
-takeScreenshot :: System s Bitmap
-takeScreenshot = mkSystem $ \fo -> G.screenshot (theSystem fo) >>= liftImage'
-
-setTitle :: String -> System s ()
-setTitle str = mkSystem $ \fo -> GLFW.setWindowTitle (G.theWindow $ theSystem fo) str
-
-instance MonadIO (System s) where
-  liftIO m = mkSystem $ const m
-  {-# INLINE liftIO #-}
-
-pollGamepad :: Foundation s -> IO ()
-pollGamepad fo = do
-  m <- readIORef (coreJoypad fo)
-  ps <- IM.fromList <$> map (\p@(Gamepad i _) -> (i, p)) <$> unSystem fo getGamepads
-  bs0 <- readIORef (theGamepadButtons fo)
-
-  bs0' <- forM (IM.toList $ ps IM.\\ bs0) $ \(i, p@(Gamepad _ s)) -> do
-    unSystem fo $ m $ PadConnection $ Up p
-    return (i, (s, IM.empty))
-
-  bs0_ <- forM (IM.toList $ bs0 IM.\\ ps) $ \(i, (s, _)) -> do
-    unSystem fo $ m $ PadConnection $ Down $ Gamepad i s
-    return (i, ())
-
-  let bs1 = bs0 `IM.union` IM.fromList bs0' IM.\\ IM.fromList bs0_
-
-  ls <- forM (IM.toList ps) $ \(j, p@(Gamepad _ s)) -> do
-    bs <- zip [0..] <$> unSystem fo (gamepadButtons p)
-    forM_ bs $ \(i, v) -> case (v, maybe False id (bs1 ^? ix j . _2 . ix i)) of
-        (False, True) -> unSystem fo $ m $ PadButton p (Up i)
-        (True, False) -> unSystem fo $ m $ PadButton p (Down i)
-        _ -> return ()
-    return (j, (s, IM.fromList bs))
-
-  writeIORef (theGamepadButtons fo) $ foldr (uncurry IM.insert) bs1 ls
-
-runGraphic :: Foundation s -> Time -> IO ()
-runGraphic fo t0 = do
-  pollGamepad fo
-  fps <- readIORef (targetFPS fo)
-  let t1 = t0 + 1/fps
-  G.beginFrame (theSystem fo)
-  m <- readIORef (coreGraphic fo)
-  pic <- unSystem fo $ m (1/fps) -- is it appropriate?
-  drawSight fo pic
-  b <- G.endFrame (theSystem fo)
-
-  Just t' <- GLFW.getTime
-  threadDelay $ floor $ (t1 - realToFrac t') * 1000 * 1000
-
-  tryTakeMVar (theEnd fo) >>= \case
-      Just _ -> return ()
-      _ | b -> putMVar (theEnd fo) ()
-        | otherwise -> runGraphic fo t1
-
-audioProcess :: Foundation s -> Int -> IO (V.Vector Stereo)
-audioProcess fo n = do
-  let dt = fromIntegral n / sampleRate fo
-  m <- readIORef (coreAudio fo)
-  unSystem fo $ m dt n
-
-keyCallback :: Foundation s -> GLFW.KeyCallback
-keyCallback fo _ k _ st _ = do
-  m <- readIORef (coreKeyboard fo)
-  unSystem fo $ m $ case st of
-    GLFW.KeyState'Released -> Up (toEnum . fromEnum $ k :: Key)
-    _ -> Down (toEnum . fromEnum $ k :: Key)
-
-mouseButtonCallback :: Foundation s -> GLFW.MouseButtonCallback
-mouseButtonCallback fo _ btn st _ = do
-  m <- readIORef (coreMouse fo)
-  unSystem fo $ m $ case st of
-    GLFW.MouseButtonState'Released -> Button $ Up (fromEnum btn)
-    _ -> Button $ Down (fromEnum btn)
-
-cursorPosCallback :: Foundation s -> GLFW.CursorPosCallback
-cursorPosCallback fo _ x y = do
-  m <- readIORef (coreMouse fo)
-  unSystem fo $ m $ Cursor $ fmap realToFrac $ V2 x y
-
-scrollCallback :: Foundation s -> GLFW.ScrollCallback
-scrollCallback fo _ x y = do
-  m <- readIORef (coreMouse fo)
-  unSystem fo $ m $ Scroll $ fmap realToFrac $ V2 x y
-
-fetchTexture :: Foundation s -> C.Image C.PixelRGBA8 -> Int -> IO G.Texture
-fetchTexture fo bmp h = do
-  st <- readIORef (textures fo)
-  case IM.lookup h st of
-    Just t -> return t
-    Nothing -> do
-      t <- G.installTexture bmp
-      writeIORef (textures fo) $ IM.insert h t st
-      return t
-
-drawScene :: Foundation s -> Box V2 Float -> M44 Float -> Bool -> Scene -> IO ()
-drawScene fo (fmap round -> Box (V2 x0 y0) (V2 x1 y1)) proj _ (Scene s) = do
-  GL.viewport $= (GL.Position x0 y0, GL.Size (x1 - x0) (y1 - y0))
-
-  GL.currentProgram $= Just shaderProg
-  GL.UniformLocation loc <- GL.get (GL.uniformLocation shaderProg "projection")
-  with proj $ \ptr -> GL.glUniformMatrix4fv loc 1 1 $ castPtr ptr
-  GL.UniformLocation locT <- GL.get $ GL.uniformLocation shaderProg "textureMix"
-  s (pure $ return ()) (liftA2 (>>)) (prim locT) fx trans (V4 1 1 1 1, 0)
-  where
-    shaderProg = G.theProgram $ theSystem fo
-    prim locT Blank mode vs _ = do
-      GL.glUniform1f locT 0
-      V.unsafeWith vs $ \v -> GL.bufferData GL.ArrayBuffer $=
-        (fromIntegral $ V.length vs * sizeOf (undefined :: Vertex), v, GL.StaticDraw)
-      GL.drawArrays mode 0 $ fromIntegral $ V.length vs
-    prim locT (Bitmap bmp _ h) mode vs _ = do
-      GL.glUniform1f locT 1
-      (tex, _, _) <- fetchTexture fo bmp h
-      GL.activeTexture $= GL.TextureUnit 0
-      GL.textureBinding GL.Texture2D $= Just tex
-      GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear')
-      V.unsafeWith vs $ \v -> GL.bufferData GL.ArrayBuffer $=
-        (fromIntegral $ V.length vs * sizeOf (undefined :: Vertex), v, GL.StaticDraw)
-      GL.drawArrays mode 0 $ fromIntegral $ V.length vs
-    trans f m (color0, n) = do
-      GL.UniformLocation loc <- GL.get $ GL.uniformLocation shaderProg "matrices"
-      GL.UniformLocation locN <- GL.get $ GL.uniformLocation shaderProg "level"
-      with f $ \ptr -> GL.glUniformMatrix4fv (loc+n) 1 1 (castPtr ptr)
-      GL.glUniform1i locN (unsafeCoerce $ n + 1)
-      m (color0, n + 1)
-      GL.glUniform1i locN (unsafeCoerce n)
-    fx (EmbedIO m) c = m >>= ($ c)
-    fx (Diffuse col m) (color0, n) = do
-      GL.UniformLocation loc <- GL.get $ GL.uniformLocation shaderProg "diffuse"
-      let c = col * color0
-      with c $ \ptr -> GL.glUniform4fv loc 1 (castPtr ptr)
-      m (c, n)
-      with color0 $ \ptr -> GL.glUniform4fv loc 1 (castPtr ptr)
-    fx (SphericalAdd (Bitmap bmp _ h) m) c = do
-      withLoc "useEnv" $ \loc -> GL.glUniform1i loc 1
-      withLoc "envAdd" $ \loc -> GL.glUniform1f loc 1
-      (tex, _, _) <- fetchTexture fo bmp h
-      GL.activeTexture $= GL.TextureUnit 1
-      GL.textureBinding GL.Texture2D $= Just tex
-      GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear')
-      m c
-      withLoc "useEnv" $ \loc -> GL.glUniform1i loc 0
-      withLoc "envAdd" $ \loc -> GL.glUniform1f loc 0
-    fx (SphericalAdd Blank m) c = m c
-    fx (SphericalMultiply (Bitmap bmp _ h) m) c = do
-      withLoc "useEnv" $ \loc -> GL.glUniform1i loc 1
-      withLoc "envMul" $ \loc -> GL.glUniform1f loc 1
-      (tex, _, _) <- fetchTexture fo bmp h
-
-      GL.activeTexture $= GL.TextureUnit 1
-      GL.textureBinding GL.Texture2D $= Just tex
-      GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear')
-      m c
-      withLoc "useEnv" $ \loc -> GL.glUniform1i loc 0
-      withLoc "envMul" $ \loc -> GL.glUniform1f loc 0
-    fx (SphericalMultiply Blank m) c = m c
-    withLoc str m = do
-      GL.UniformLocation loc <- GL.get $ GL.uniformLocation shaderProg str
-      m loc
-
-drawSight :: Foundation s -> Sight -> IO ()
-drawSight fo (Sight s) = do
-  b <- readIORef $ G.refRegion $ theSystem fo
-  s b (return ()) (>>) (drawScene fo)
diff --git a/src/Call/TH.hs b/src/Call/TH.hs
deleted file mode 100644
--- a/src/Call/TH.hs
+++ /dev/null
@@ -1,67 +0,0 @@
-{-# LANGUAGE TemplateHaskell, CPP #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Call.TH
--- Copyright   :  (c) Fumiaki Kinoshita 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable
---
--- Utilities that use Template Haskell
---
------------------------------------------------------------------------------
-module Call.TH (
-    loadBitmapsWith
-    ) where
-
-import Control.Applicative
-import Control.Monad
-import Data.Char
-import qualified Call.Data.Bitmap as Bitmap
-import Language.Haskell.TH
-import System.Directory
-import System.FilePath
-import System.IO.Unsafe
-
--- | The type of the given 'ExpQ' must be @FilePath -> IO FilePath@
--- FIXME: This may cause name duplication if there are multiple non-alphanumeric file names.
-loadBitmapsWith :: ExpQ -> FilePath -> Q [Dec]
-loadBitmapsWith getFullPath path = do
-    loc <- (</>path) <$> takeDirectory <$> loc_filename <$> location
-    paths <- runIO $ getFileList loc
-    
-    sequence $ do
-        p <- paths
-        let name = pathToName p
-        [ return $ SigD (mkName name) (ConT ''Bitmap.Bitmap)
-            , funD (mkName name) [clause [] (normalB $ load name $ loc </> p) []]
-            ]
-    where
-        load name fp = do
-            runIO $ putStrLn $ "Defined: " ++ fp ++ " as `" ++ name ++ "'"
-
-            appE (varE 'unsafePerformIO) $ uInfixE (appE getFullPath $ litE $ StringL fp)
-                (varE '(>>=))
-                (varE 'Bitmap.readFile)
-
--- | Load and define all pictures in the specified directory.
--- On base >= 4.6, file paths to actually load will be respect to the directory of the executable. Otherwise it will be based on the current directory.
-
-
-getFileList :: FilePath -> IO [FilePath]
-getFileList path = do
-    allContents <- filter notHidden `fmap` getDirectoryContents path
-
-    files <- filterM (doesFileExist . (path</>)) allContents
-    dirs <- filterM (doesDirectoryExist . (path</>)) allContents
-    fmap ((files++).concat) $ forM dirs $ \i -> map (i</>) `fmap` getFileList (path</>i)
-    where
-        notHidden ('.':_) = False
-        notHidden _ = True
-
-pathToName :: FilePath -> String
-pathToName = ('_':) . map p where
-    p c | isAlphaNum c = c
-        | otherwise = '_'
diff --git a/src/Call/Types.hs b/src/Call/Types.hs
deleted file mode 100644
--- a/src/Call/Types.hs
+++ /dev/null
@@ -1,233 +0,0 @@
-{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveDataTypeable #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Call.Types
--- Copyright   :  (c) Fumiaki Kinoshita 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable
---
------------------------------------------------------------------------------
-module Call.Types (
-    Time
-    , Vec2
-    , Vec3
-    , Stereo
-    , WindowMode(..)
-    , MouseEvent(..)
-    , Gamepad(..)
-    , GamepadEvent(..)
-    , Chatter(..)
-    , Key(..)
-    , charToKey
-    , BlendMode(..)
-    , Vertex(..)
-    , positionUV
-    , positionOnly
-    , Bitmap(..)
-    ) where
-
-import Control.Applicative
-import Linear
-import Data.Typeable
-import Data.Char
-import Foreign.Storable
-import Foreign.Ptr
-import Call.Data.Bitmap
-
-type Time = Float
-type Stereo = V2 Float
-type Vec2 = V2 Float
-type Vec3 = V3 Float
-data WindowMode = Windowed | Resizable | FullScreen deriving (Show, Eq, Ord, Read, Typeable)
-
-data Chatter a = Up a | Down a deriving (Show, Eq, Ord, Read, Typeable)
-
-data MouseEvent = Button (Chatter Int) | Cursor Vec2 | Scroll Vec2 deriving (Show, Eq, Ord, Read, Typeable)
-
-data Gamepad = Gamepad Int String deriving (Show, Eq, Ord, Read, Typeable)
-
-data GamepadEvent = PadButton Gamepad (Chatter Int) | PadConnection (Chatter Gamepad) deriving (Show, Eq, Ord, Read, Typeable)
-
-data Key =
-      KeyUnknown
-    | KeySpace
-    | KeyApostrophe
-    | KeyComma
-    | KeyMinus
-    | KeyPeriod
-    | KeySlash
-    | Key0
-    | Key1
-    | Key2
-    | Key3
-    | Key4
-    | Key5
-    | Key6
-    | Key7
-    | Key8
-    | Key9
-    | KeySemicolon
-    | KeyEqual
-    | KeyA
-    | KeyB
-    | KeyC
-    | KeyD
-    | KeyE
-    | KeyF
-    | KeyG
-    | KeyH
-    | KeyI
-    | KeyJ
-    | KeyK
-    | KeyL
-    | KeyM
-    | KeyN
-    | KeyO
-    | KeyP
-    | KeyQ
-    | KeyR
-    | KeyS
-    | KeyT
-    | KeyU
-    | KeyV
-    | KeyW
-    | KeyX
-    | KeyY
-    | KeyZ
-    | KeyLeftBracket
-    | KeyBackslash
-    | KeyRightBracket
-    | KeyGraveAccent
-    | KeyWorld1
-    | KeyWorld2
-    | KeyEscape
-    | KeyEnter
-    | KeyTab
-    | KeyBackspace
-    | KeyInsert
-    | KeyDelete
-    | KeyRight
-    | KeyLeft
-    | KeyDown
-    | KeyUp
-    | KeyPageUp
-    | KeyPageDown
-    | KeyHome
-    | KeyEnd
-    | KeyCapsLock
-    | KeyScrollLock
-    | KeyNumLock
-    | KeyPrintScreen
-    | KeyPause
-    | KeyF1
-    | KeyF2
-    | KeyF3
-    | KeyF4
-    | KeyF5
-    | KeyF6
-    | KeyF7
-    | KeyF8
-    | KeyF9
-    | KeyF10
-    | KeyF11
-    | KeyF12
-    | KeyF13
-    | KeyF14
-    | KeyF15
-    | KeyF16
-    | KeyF17
-    | KeyF18
-    | KeyF19
-    | KeyF20
-    | KeyF21
-    | KeyF22
-    | KeyF23
-    | KeyF24
-    | KeyF25
-    | KeyPad0
-    | KeyPad1
-    | KeyPad2
-    | KeyPad3
-    | KeyPad4
-    | KeyPad5
-    | KeyPad6
-    | KeyPad7
-    | KeyPad8
-    | KeyPad9
-    | KeyPadDecimal
-    | KeyPadDivide
-    | KeyPadMultiply
-    | KeyPadSubtract
-    | KeyPadAdd
-    | KeyPadEnter
-    | KeyPadEqual
-    | KeyLeftShift
-    | KeyLeftControl
-    | KeyLeftAlt
-    | KeyLeftSuper
-    | KeyRightShift
-    | KeyRightControl
-    | KeyRightAlt
-    | KeyRightSuper
-    | KeyMenu
-    deriving (Enum, Eq, Ord, Read, Show, Typeable, Bounded)
-
-charToKey :: Char -> Key
-charToKey ch
-    | isAlpha ch = toEnum $ fromEnum KeyA + fromEnum ch - fromEnum 'A'
-    | isDigit ch = toEnum $ fromEnum Key0 + fromEnum ch - fromEnum '0'
-charToKey '-' = KeyMinus
-charToKey ',' = KeyComma
-charToKey '.' = KeyPeriod
-charToKey '/' = KeySlash
-charToKey ' ' = KeySpace
-charToKey '\'' = KeyApostrophe
-charToKey '\\' = KeyBackslash
-charToKey '=' = KeyEqual
-charToKey ';' = KeySemicolon
-charToKey '[' = KeyLeftBracket
-charToKey ']' = KeyRightBracket
-charToKey '`' = KeyGraveAccent
-charToKey '\n' = KeyEnter
-charToKey '\r' = KeyEnter
-charToKey '\t' = KeyTab
-charToKey _ = KeyUnknown
-
-data BlendMode = Normal
-    | Inverse
-    | Add
-    | Multiply
-    | Screen
-    deriving (Enum, Eq, Ord, Read, Show, Typeable)
-
-data Vertex = Vertex { vPos :: {-# UNPACK #-} !Vec3
-  , vUV :: {-# UNPACK #-} !Vec2
-  , vNormal :: {-# UNPACK #-} !Vec3 }
-  deriving (Show, Eq, Ord, Read, Typeable)
-
-align1 :: Int
-align1 = sizeOf (vPos undefined)
-
-align2 :: Int
-align2 = align1 + sizeOf (vUV undefined)
-
-instance Storable Vertex where
-  sizeOf _ = sizeOf (undefined :: Vec3) + sizeOf (undefined :: Vec2) + sizeOf (undefined :: Vec3)
-  alignment _ = 0
-  peek ptr = Vertex
-    <$> peek (castPtr ptr)
-    <*> peek (castPtr $ ptr `plusPtr` align1)
-    <*> peek (castPtr $ ptr `plusPtr` align2)
-  poke ptr (Vertex v t n) = do
-    poke (castPtr ptr) v
-    poke (castPtr ptr `plusPtr` align1) t
-    poke (castPtr ptr `plusPtr` align2) n
-
-positionUV :: Vec3 -> Vec2 -> Vertex
-positionUV v p = Vertex v p zero
-
-positionOnly :: Vec3 -> Vertex
-positionOnly v = Vertex v zero zero
diff --git a/src/Call/Util/Deck.hs b/src/Call/Util/Deck.hs
deleted file mode 100644
--- a/src/Call/Util/Deck.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE ConstraintKinds #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Call.Util.Deck
--- Copyright   :  (c) Fumiaki Kinoshita 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable
---
--- The deck for a single stream
---
------------------------------------------------------------------------------
-module Call.Util.Deck (Deck(..), empty, source, pos, playing, playback, playbackOf) where
-import Control.Lens
-import Control.Monad.State.Strict
-import Call.Data.Wave
-import Call.Types
-import qualified Data.Vector.Storable as V
-import Control.Object
-
-data Deck = Deck
-  { _src :: Source Stereo
-  , _pos :: !Time
-  , _playing :: !Bool }
-
-empty :: Deck
-empty = Deck (Source $ const 0) 0 False
-
-source :: Lens' Deck (Source Stereo)
-source f s = f (_src s) <&> \a -> s { _src = a }
-
-pos :: Lens' Deck Time
-pos f s = f (_pos s) <&> \a -> s { _pos = a }
-
-playing :: Lens' Deck Bool
-playing f s = f (_playing s) <&> \a -> s { _playing = a }
-
-playback :: MonadState Deck m => Time -> Int -> m (V.Vector Stereo)
-playback dt n = do
-  Source s <- use source
-  pl <- use playing
-  t0 <- use pos
-  if pl
-    then do
-      pos += dt
-      return $ V.fromList $ take n $ map s [t0,t0 + dt / fromIntegral n..]
-    else return $ V.replicate n 0
-
-playbackOf :: (MonadIO m, MonadState Deck b) => Instance b m -> Time -> Int -> m (V.Vector Stereo)
-playbackOf i = \dt n -> i .- playback dt n
diff --git a/src/Call/Util/Sampler.hs b/src/Call/Util/Sampler.hs
deleted file mode 100644
--- a/src/Call/Util/Sampler.hs
+++ /dev/null
@@ -1,52 +0,0 @@
-{-# LANGUAGE FlexibleContexts, ConstraintKinds #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Call.Util.Deck
--- Copyright   :  (c) Fumiaki Kinoshita 2014
--- License     :  BSD3
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  experimental
--- Portability :  non-portable
---
--- Polyphonic sampler
---
------------------------------------------------------------------------------
-module Call.Util.Sampler where
-import qualified Data.Vector.Storable as V
-import qualified Data.Vector.Storable.Mutable as MV
-import Control.Monad.ST
-import Control.Monad.State.Strict
-import Call.Types
-import Call.Data.Wave
-import Control.Object
-
-data Sampler = Sampler [(Sample Stereo, Time)]
-
-empty :: Sampler
-empty = Sampler []
-
-playback :: MonadState Sampler m => Time -> Int -> m (V.Vector Stereo)
-playback dt n = do
-  Sampler vs <- get
-  let (vs'', r) = runST $ do
-        v <- MV.new n
-        vs' <- forM vs $ \(s0@(Sample d (Source s)), t0) -> do
-          if d > t0 then return []
-            else do
-              forM_ [0..n-1] $ \i -> do
-                z <- MV.unsafeRead v i
-                MV.unsafeWrite v i $ z + s (t0 + f * fromIntegral i)
-              return [(s0, t0 + dt)]
-        v' <- V.unsafeFreeze v
-        return (vs', v')
-  put $ Sampler $ concat vs''
-  return r
-  where
-    f = dt / fromIntegral n
-
-play :: MonadState Sampler m => Sample Stereo -> m ()
-play s = modify $ \(Sampler xs) -> Sampler $ (s, 0) : xs
-
-playbackOf :: (MonadIO m, MonadState Sampler b) => Instance b m -> Time -> Int -> m (V.Vector Stereo)
-playbackOf i = \dt n -> i .- playback dt n
diff --git a/src/Call/Util/Text.hs b/src/Call/Util/Text.hs
deleted file mode 100644
--- a/src/Call/Util/Text.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# LANGUAGE ConstraintKinds, FlexibleContexts, BangPatterns, DeriveFunctor #-}
-module Call.Util.Text (renderer, Typewriting(..), typewriter, putStr, clear, simple) where
-import Prelude hiding (putStr)
-import Call.Data.Bitmap (Bitmap(..))
-import Call.Data.Font
-import Call.Sight
-import Control.Lens hiding (simple)
-import Control.Monad.Free
-import Control.Monad.State.Class
-import Control.Monad.Trans
-import Control.Applicative
-import Control.Object
-import Data.Monoid
-import Linear
-import Control.DeepSeq
-
-data Typewriting a = Render (Picture -> a) | Type Char a deriving Functor
-
-renderer :: (MonadIO m, Applicative m) => Font -> Float -> Object (Request Char (Bitmap, V2 Float, V2 Float)) m
-renderer font size = flyweight (liftIO . renderChar font size)
-
-typewriter :: MonadIO m => Float -> (Char -> m (Bitmap, V2 Float, V2 Float)) -> Object (Free Typewriting) m
-typewriter l req = iterative $ stateful go (V2 0 0, mempty) where
-  go (Type '\3' cont) = do
-    put (V2 0 0, mempty)
-    return cont
-  go (Type '\r' cont) = return cont
-  go (Type '\n' cont) = do
-    _1 . _y += l
-    _1 . _x .= 0
-    return cont
-  go (Type ch cont) = do
-    (pos, pic) <- get
-    (!bmp@(Bitmap img _ _), !ofs, !adv) <- lift $ req ch
-    return $! rnf img
-    put (pos + adv, pic <> translate (pos + ofs) (bitmap bmp))
-    return cont
-  go (Render cont) = uses _2 cont
-
-putStr :: String -> Free Typewriting ()
-putStr [] = return ()
-putStr (c:cs) = wrap (Type c (putStr cs))
-
-clear :: Free Typewriting ()
-clear = liftF $ Type '\3' ()
-
-simple :: MonadIO m => Font -> Float -> m (String -> Picture)
-simple font size = liftIO $ do
-  r <- new $ renderer font size
-  t <- new $ typewriter (size * 1.2) ((r.-) . request)
-  return $ \s -> Picture $ applyVFX $ EmbedIO $ do
-    t .- putStr s
-    p <- t .- liftF (Render id)
-    t .- clear
-    return $! unPicture p