module Main where

import Control.Monad
import qualified Data.Map as M
import qualified Graphics.UI.SDL as S
import qualified Graphics.UI.SDL.Image as I
import Sound.OpenSoundControl
--import System.Environment

data Img = Img { im :: M.Map Int S.Surface
               , fd :: UDP }

as_int :: Datum -> Int
as_int (Int x) = x
as_int (Float x) = floor x
as_int (Double x) = floor x
as_int _ = undefined

mk_img :: IO Img
mk_img = 
    do u <- udpServer "127.0.0.1" 57147
       S.setVideoMode 100 100 24 [S.SWSurface]
       S.setCaption "img.osc" ""
       S.enableUnicode True
       return (Img M.empty u)

img_load :: Img -> Int -> String -> IO Img
img_load i n f = 
    do s <- I.load f
       let m = M.insert n s (im i)
       return (i { im = m })

img_blit :: Img -> IO Img
img_blit i =
    do s <- S.getVideoSurface
       S.flip s
       return i

img_cpy_all :: Img -> Int -> IO Img
img_cpy_all i n =
    do s <- S.getVideoSurface
       S.blitSurface (im i M.! n) Nothing s Nothing
       return i

img_cpy :: Img -> Int -> (Int, Int) -> (Int, Int) -> (Int, Int) -> IO Img
img_cpy i n (xs, ys) (w, h) (xd, yd) =
    do s <- S.getVideoSurface
       S.blitSurface (im i M.! n) (Just (S.Rect xs ys w h)) s (Just (S.Rect xd yd w h))
       return i

img_resize :: Img -> Int -> Int -> IO Img
img_resize i w h =
    do S.setVideoMode w h 24 [S.SWSurface]
       return i

img_resize_for :: Img -> Int -> IO Img
img_resize_for i n =
    do let w = S.surfaceGetWidth (im i M.! n)
           h = S.surfaceGetHeight (im i M.! n)
       img_resize i w h

sync :: IO Img -> IO (Bool, Img)
sync = liftM ((,) False)

async :: IO Img -> IO (Bool, Img)
async = liftM ((,) True)

img_ctl :: Img -> OSC -> IO (Bool, Img)
img_ctl i m = 
    case m of
      (Bundle _ xs) -> mapM (img_ctl i) xs >>= return . last
      (Message "/load" [Int n, String fn]) -> async (img_load i n fn)
      (Message "/cpy" [n,xs,ys,w,h,xd,yd]) -> sync (img_cpy 
                                                    i 
                                                    (as_int n) 
                                                    (as_int xs, as_int ys)
                                                    (as_int w, as_int h)
                                                    (as_int xd, as_int yd))
      (Message "/cpy_all" [n]) -> sync (img_cpy_all i (as_int n))
      (Message "/blit" []) -> sync (img_blit i)
      (Message "/resize" [Int w, Int h]) -> async (img_resize i w h)
      (Message "/resize_for" [Int n]) -> async (img_resize_for i n)
      _ -> putStrLn ("dropped packet: " ++ show m) >> async (return i)

work :: Img -> IO ()
work i = 
    do (m, a) <- recvFrom (fd i)
       (s, i') <- img_ctl i m
       if s then sendTo (fd i) (Message "/done" []) a else return ()
       work i'

main :: IO ()
main = S.withInit [S.InitVideo] $ 
    do i <- mk_img
       work i