-- | Shell
module Sound.SC3.Cairo.Scope.Shell where

import Data.IORef {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Data.List.Split {- split -}
import qualified Graphics.Rendering.Cairo as C {- cairo -}
import qualified Graphics.UI.Gtk as G {- gtk -}
import qualified Graphics.UI.Gtk.Gdk.Events as E {- gtk -}
import Sound.OSC.FD {- hosc -}
import Sound.SC3.FD {- hsc3 -}

-- * Types

type Render_F st = Shell st -> st -> C.Render st
type Interact_F st = UDP -> Shell st -> st -> IO st
type Bracket_F st = (Interact_F st,Interact_F st)
type SC3_F st = Interact_F st
type Key_F st = Char -> st -> st
data Shell st = Shell {sh_gr :: Int -- ^ Group (protected)
                      ,sh_nc :: Int -- ^ Number of channels
                      ,sh_nf :: Int -- ^ Number of frames
                      ,sh_b :: Int -- ^ Buffer ID
                      ,sh_ix :: Int -- ^ Bus index
                      ,sh_data :: [[Double]] -- ^ Signal data
                      ,sh_bracket :: Bracket_F st
                      ,sh_sc3 :: SC3_F st
                      ,sh_render :: Render_F st
                      ,sh_key :: Key_F st
                      ,sh_delay :: Int -- ^ Frame delay in ms
                      }

sh_bracket_nil :: Bracket_F st
sh_bracket_nil =
    let no_op _ _ st = return st
    in (no_op,no_op)

sh_sc3_nil :: SC3_F st
sh_sc3_nil _ _ st = return st

sh_monitor_bus :: Transport t => Shell st -> t -> IO ()
sh_monitor_bus sh fd = do
  let b = fromIntegral (sh_b sh)
      ix = fromIntegral (sh_ix sh)
      i = in' (sh_nc sh) AR ix
      r = recordBuf AR b 0 1 0 1 Loop 1 DoNothing i
      s = synthdef "sh_monitor_bus" r
  _ <- async fd (d_recv s)
  _ <- async fd (b_alloc (sh_b sh) (sh_nf sh) (sh_nc sh))
  send fd (g_new [(sh_gr sh,AddToTail,0)])
  send fd (s_new "sh_monitor_bus" (-1) AddToTail (sh_gr sh) [])

deinterleave :: Int -> [a] -> [[a]]
deinterleave nc l =
    case nc of
      1 -> [l]
      _ -> transpose (chunksOf nc l)

sh_std_sc3 :: Transport t => Shell st -> t -> IO (Shell st)
sh_std_sc3 sh fd = do
  let b = sh_b sh
      nf = sh_nf sh
      nc = sh_nc sh
  send fd (b_getn b [(0,nf * nc)])
  r <- waitDatum fd "/b_setn"
  let d = case r of
            _:Int32 0:Int32 _:xs -> mapMaybe datum_floating xs
            _ -> []
  return (sh {sh_data = deinterleave nc d})

sh_on_close :: UDP -> Shell b -> b -> IO b
sh_on_close fd sh st = do
  let (_,c_f) = sh_bracket sh
  send fd (n_free [3])
  c_f fd sh st

sh_keypress_f :: G.WidgetClass w =>
                 w -> IORef st -> UDP -> Shell st -> E.Event -> IO Bool
sh_keypress_f w r fd sh e = do
  let kv = E.eventKeyVal e
      nm = E.eventKeyName e
  case nm of
    "Escape" -> do st <- readIORef r
                   _ <- sh_on_close fd sh st
                   G.widgetDestroy w
    _ -> case G.keyToChar kv of
           Just c -> modifyIORef r (sh_key sh c)
           _ -> return ()
  return True

sh_update_f :: G.WidgetClass w =>
               w -> C.Surface -> IORef st -> UDP -> Shell st -> IO Bool
sh_update_f c s r fd sh = do
  w <- G.widgetGetDrawWindow c
  bd <- readIORef r
  sh' <- sh_std_sc3 sh fd
  bd' <- sh_sc3 sh' fd sh' bd >>= C.renderWith s . sh_render sh' sh'
  C.surfaceFlush s
  _ <- G.renderWithDrawable w (C.setSourceSurface s 0 0 >> C.paint)
  writeIORef r bd'
  return True

sc3_fd :: IO UDP
sc3_fd = openUDP "127.0.0.1" 57110

shell :: Shell st -> st -> IO ()
shell sh i_st = do
  let n = sh_nf sh
      n' = fromIntegral n
      (i_f,_) = sh_bracket sh
  fd <- sc3_fd
  st <- i_f fd sh i_st
  sh_monitor_bus sh fd
  r <- newIORef st
  s <- C.createImageSurface C.FormatARGB32 n n
  C.renderWith s (do C.rectangle 0 0 n' n'
                     C.setSourceRGBA 0 0 0 1
                     C.fill)
  _ <- G.initGUI
  w <- G.windowNew
  c <- G.drawingAreaNew
  G.windowSetResizable w False
  G.widgetSetSizeRequest w n n
  _ <- G.onKeyPress w (sh_keypress_f w r fd sh)
  _ <- G.onDestroy w G.mainQuit
  _ <- G.onExpose c (const (sh_update_f c s r fd sh))
  _ <- G.timeoutAdd (G.widgetQueueDraw w >> return True) (sh_delay sh)
  G.set w [G.containerChild G.:= c]
  G.widgetShowAll w
  G.mainGUI

sh_default :: Int -> Render_F st -> Key_F st -> Shell st
sh_default nc r k = Shell 3 nc 512 10 0 [] sh_bracket_nil sh_sc3_nil r k 15