
{-# OPTIONS_GHC -fglasgow-exts #-}
module Main where

import Control.Monad
import Data.Array.IArray

import Graphics.UI.WX hiding (color)

import Graphics.UI.WXCore.WxcClassesAL (logStatus)

import Graphics.UI.WX.Controls.Knob
import Graphics.UI.WX.Controls.ColorWidget
import Graphics.UI.WX.Controls.EnvelopeWidget
import Graphics.UI.WX.Controls.TimelineComposite

-------------------------------------------------------

myblocks = Timeline (0,5000) arr where
  arr = accumArray (flip const) (SL []) (1,16) $ map ( \ (i,xs) -> (i,SL xs) ) $
    [ (1, [block (130*i+40) 80 (250,250,80) ("xxx "  ++show i) | i<-[2..6] ] ) 
    , (2, [block (100*i+10) 60 (200,0,0) ("alma "  ++show i)   | i<-[0..10] ] )
    , (3, [block (80 *i+ 0) 50 (0,200,0) ("korte " ++show i)   | i<-[0..5] ] )
    , (4, [block (90 *i+20) 60 (0,0,200) ("szilva "++show i)   | i<-[2..8] ] ) 
    , (7, [block (100*i+30) 50 (0,200,200) ("ee "++show i)     | i<-[2..8] ] )
    , (8, [block (100*i+80) 50 (200,0,200) ("ff "++show i)     | i<-[2..8] ] )
    ]
  block start dur (ri,gi,bi) text = Block 
    (start,start+dur)
    text
    (h ri, h gi, h bi)
    ()
  h i = fromIntegral i / 255.0 :: Float
  
--------------

hello :: IO ()
hello = do 
  fr   <- frame [ text := "wxWidgets sucks donkey balls" ]

  status <- statusField [ text := "status bar \\o/" ]
  set fr [ statusBar := [status] ]
  
  p <- panel fr []

  quit <- button p [text := "Quit", on command := do { close fr } ]

  colorw <- makeColorWidget p True []
  env <- makeEnvelopeWidget p 4 True [] -- False []

  knobs <- replicateM 12 $ makeKnob p 0 127 []
  forM_ (zip [1..] knobs) $ \(i,k) -> set k [ tooltip := "knob #" ++ show i , selection := i*10 ]
  let knobtable = grid 0 0   
        [ [ widget $ knobs!!(i*4+j) | j<-[0..3] ] | i<-[0..2] ]

  let toSamples i = round (44.1 * fromIntegral i :: Double)
  wave <- makeTestWave 4
  composite <- makeTimelineComposite p 12 20 (0,5000) 24 (Just (60,wave,toSamples)) [ blocks := myblocks ]

  set composite 
    [ onBlockInsert := \lev iv -> return $ Just $ Block iv "new event" (0.70,0.65,0.60) () 
    , onBlockSelect := \(lev,block) -> logStatus ("selected: `" ++ _block_name block ++ "' @ level " ++ show lev)
    ]

  set p [ layout := margin 10 $ column 10
           [ hfill $ row 10
             [ column 10 $ 
               [ 
                 floatCentre (widget colorw)
               , floatCentre (label "wx-controls-extra demo")
               , floatCentre (widget quit)
               , (widget knobtable)
               ]
             , fill (widget env)
             ]
           , fill (widget composite) 
           ]
         ]
         
  set fr [ layout := fill (widget p) ]
       
main = do
  start hello
