minimung-0.0: Minimung.hs

-- |
-- Maintainer : Yakov Zaytsev <yakov@yakov.cc>
-- Stability  : experimental
--
-- This example shows how to run the Sequence Grabber in record mode
-- and how to get and modify the captured data.
--

module Main where

import System.Exit(exitWith, ExitCode(ExitSuccess))
import Graphics.UI.GLUT
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import Data.Bits

import Mac
import Data.Image
import Data.Camera

toGray :: (RGB a) => Image a -> Image (Index1 GLubyte)
toGray f = \(x, y) -> toY $ f (x, y)

toY :: (RGB a, Num b) => a -> Index1 b
toY color = let (r, g, b) = toRGB color
            in Index1 $ fromIntegral $ (r + (r `shiftL` 2) + g + (g `shiftL` 3) + (b + b)) `shiftR` 4

timer :: (RGB a) => Camera a -> TimerCallback
timer camera = do
  frame <- camera
  let g = toGray frame
  size@(Size w h) <- get windowSize
  gg <- mallocBytes $ fromIntegral (w * h)
  g *| (gg, size)
  drawPixels size (PixelData Luminance UnsignedByte gg)
  addTimerCallback 40 $ timer camera
  flush

display :: DisplayCallback
display = do
  flush

keyboard :: KeyboardMouseCallback
keyboard (Char '\27') Down _   _ = exitWith ExitSuccess

main :: IO ()
main = do
  initCursor
  enterMovies
  camera <- with Rect { top = 0
                      , left = 0
                      , bottom = 480
                      , right = 640 } $ \r -> newSGChannel r
  getArgsAndInitialize
  initialWindowPosition $= Position 100 100
  initialWindowSize $= Size 640 480
  initialDisplayMode $= [SingleBuffered, RGBMode]
  createWindow "Minimung"
  clearColor $= Color4 0 0 0 0
  shadeModel $= Flat
  rowAlignment Unpack $= 1
  displayCallback $= display
  keyboardMouseCallback $= Just keyboard
  addTimerCallback 40 $ timer camera
  mainLoop