module Csound.Control.Gui.Widget (
ValDiap(..), ValStep, ValScaleType(..), ValSpan(..),
linSpan, expSpan, uspan, bspan, uspanExp,
count, countSig, joy,
knob, KnobType(..), setKnobType,
roller,
slider, sliderBank, SliderType(..), setSliderType,
numeric, TextType(..), setTextType,
box, BoxType(..), setBoxType,
button, ButtonType(..), setButtonType,
toggle, butBank, toggleSig, butBankSig,
butBank1, butBankSig1,
radioButton, matrixButton, funnyRadio, funnyMatrix,
setNumeric, meter,
setKnob, setSlider,
setToggle, setToggleSig,
setTitle,
KeyEvt(..), Key(..), keyIn, charOn, charOff, strOn, strOff,
uknob, xknob, uslider, xslider, ujoy,
hradio, vradio, hradioSig, vradioSig,
hnumbers, vnumbers,
Range,
rangeKnob, rangeSlider, rangeKnobSig, rangeSliderSig,
rangeJoy, rangeJoy2, rangeJoySig,
knobPad, togglePad, buttonPad, genPad,
button', toggle', toggleSig', knob', slider', uknob', uslider',
hradio', vradio', hradioSig', vradioSig'
) where
import Control.Monad
import Data.Monoid
import Data.List(transpose)
import Data.Boolean
import Csound.Typed.Gui
import Csound.Typed.Types
import Csound.Control.SE
import Csound.SigSpace(uon)
import Csound.Control.Evt(listAt, Tick, snaps2, dropE, devt, loadbang, evtToSig)
import Csound.Typed.Opcode(changed)
readMatrix :: Int -> Int -> [a] -> [a]
readMatrix xn yn as = transp $ take (xn * yn) $ as ++ repeat (head as)
where
transp xs = concat $ transpose $ parts yn xn xs
parts x y qs
| x == 0 = []
| otherwise = a : parts (x - 1) y b
where (a, b) = splitAt y qs
radioButton :: Arg a => String -> [(String, a)] -> Int -> Source (Evt a)
radioButton title as initVal = source $ do
(g, ind) <- unSource $ butBank1 "" 1 (length as) (0, initVal)
gnames <- mapM (unDisplay . box) names
let val = listAt vals ind
gui <- setTitle title $ padding 0 $ hor [sca 0.15 g, ver gnames]
return (gui, val)
where (names, vals) = unzip as
matrixButton :: Arg a => String -> Int -> Int -> [a] -> (Int, Int) -> Source (Evt a)
matrixButton name xn yn vals initVal = source $ do
(gui, ind) <- unSource $ butBank1 name xn yn initVal
let val = listAt allVals ind
return (gui, val)
where allVals = readMatrix xn yn vals
funnyRadio :: Tuple b => String -> [(String, a -> b)] -> Int -> Source (a -> b)
funnyRadio name as initVal = source $ do
(gui, ind) <- unSource $ radioButton name (zip names (fmap int [0 ..])) initVal
contInd <- stepper (sig $ int initVal) $ fmap sig ind
let instr x = guardedTuple (
zipWith (\n f -> (contInd ==* (sig $ int n), f x)) [0 ..] funs
) (head funs x)
return (gui, instr)
where (names, funs) = unzip as
funnyMatrix :: Tuple b => String -> Int -> Int -> [(a -> b)] -> (Int, Int) -> Source (a -> b)
funnyMatrix name xn yn funs initVal@(x0, y0) = source $ do
(gui, ind) <- unSource $ butBank1 name xn yn initVal
contInd <- stepper flattenInitVal $ fmap sig ind
let instr x = guardedTuple (
zipWith (\n f -> (contInd ==* (sig $ int n), f x)) [0 ..] allFuns
) (head allFuns x)
return (gui, instr)
where
allFuns = readMatrix xn yn funs
flattenInitVal = sig $ int $ y0 + x0 * yn
charOn :: Char -> Evt Unit
charOn = keyIn . Press . CharKey
charOff :: Char -> Evt Unit
charOff = keyIn . Release . CharKey
strOn :: String -> Tick
strOn a = mconcat $ fmap charOn a
strOff :: String -> Tick
strOff a = mconcat $ fmap charOff a
uslider :: Double -> Source Sig
uslider = slider "" (linSpan 0 1)
uknob :: Double -> Source Sig
uknob = knob "" (linSpan 0 1)
xslider :: Range Double -> Double -> Source Sig
xslider (a, b) initVal = slider "" (expSpan a b) initVal
xknob :: Range Double -> Double -> Source Sig
xknob (a, b) initVal = knob "" (expSpan a b) initVal
ujoy :: (Double, Double) -> Source (Sig, Sig)
ujoy = joy (linSpan 0 1) (linSpan 0 1)
hnumbers :: [Double] -> Source Sig
hnumbers = genNumbers hor
vnumbers :: [Double] -> Source Sig
vnumbers = genNumbers ver
genNumbers :: ([Gui] -> Gui) -> [Double] -> Source Sig
genNumbers gx as@(d:ds) = source $ do
ref <- newGlobalCtrlRef (sig $ double d)
(gs, evts) <- fmap unzip $ mapM (unSource . button . show) as
zipWithM_ (\x e -> runEvt e $ \_ -> writeRef ref (sig $ double x)) as evts
res <- readRef ref
return (gx gs, res)
knobPad :: Int -> Int -> [String] -> [Double] -> Source (Int -> Int -> Sig)
knobPad = genPad mkKnob 0.5
where mkKnob name = knob name uspan
togglePad :: Int -> Int -> [String] -> [Bool] -> Source (Int -> Int -> Evt D)
togglePad = genPad toggle False
buttonPad :: Int -> Int -> [String] -> Source (Int -> Int -> Evt Unit)
buttonPad width height names = genPad mkButton False width height names []
where mkButton name _ = button name
genPad :: (String -> a -> Source b) -> a -> Int -> Int -> [String] -> [a] -> Source (Int -> Int -> b)
genPad mk initVal width height names as = source $ do
(gui, vals) <- fmap reGroupCol $ mapM mkRow inits
let f x y = (vals !! y) !! x
return $ (gui, f)
where
mkRow xs = fmap reGroupRow $ mapM (unSource . uncurry mk) xs
inits = split height width $ zip (names ++ repeat "") (as ++ repeat initVal)
split m n xs = case m of
0 -> []
a -> (take n xs) : split (a - 1) n (drop n xs)
reGroupCol = reGroup ver
reGroupRow = reGroup hor
reGroup f as = (f xs, ys)
where (xs, ys) = unzip as
hradio :: [String] -> Int -> Source (Evt D)
hradio = radioGroup hor
vradio :: [String] -> Int -> Source (Evt D)
vradio = radioGroup ver
hradioSig :: [String] -> Int -> Source Sig
hradioSig = radioGroupSig hor
vradioSig :: [String] -> Int -> Source Sig
vradioSig = radioGroupSig ver
radioGroup :: ([Gui] -> Gui) -> [String] -> Int -> Source (Evt D)
radioGroup gcat names initVal = mapSource snaps $ radioGroupSig gcat names initVal
radioGroupSig :: ([Gui] -> Gui) -> [String] -> Int -> Source Sig
radioGroupSig gcat names initVal = source $ do
(guis, writes, reads) <- fmap unzip3 $ mapM (\(i, tag) -> unSinkSource $ flip setToggleSig (i == initVal) tag) $ zip [0 ..] names
curRef <- newGlobalCtrlRef (sig $ int initVal)
current <- readRef curRef
zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids
zipWithM_ (\r i -> runEvt (snaps r) $ \x -> do
when1 (sig x ==* 1) $ do
writeRef curRef i
when1 (sig x ==* 0 &&* current ==* i) $ do
writeRef curRef i
) reads ids
res <- readRef curRef
return (gcat guis, res)
where
ids = fmap (sig . int) [0 .. length names - 1]
type Range a = (a, a)
rangeKnobSig :: Range Int -> Int -> Source Sig
rangeKnobSig = rangeSig1 uknob
rangeSliderSig :: Range Int -> Int -> Source Sig
rangeSliderSig = rangeSig1 uslider
rangeKnob :: Bool -> Range Int -> Int -> Source (Evt D)
rangeKnob = rangeEvt1 uknob
rangeSlider :: Bool -> Range Int -> Int -> Source (Evt D)
rangeSlider = rangeEvt1 uslider
rangeSig1 :: (Double -> Source Sig) -> Range Int -> Int -> Source Sig
rangeSig1 widget range initVal = mapSource (fromRelative range) $ widget $ toRelativeInitVal range initVal
rangeEvt1 :: (Double -> Source Sig) -> Bool -> Range Int -> Int -> Source (Evt D)
rangeEvt1 widget isInit range initVal = mapSource (addInit . snaps) $ rangeSig1 widget range initVal
where
addInit
| isInit = ((devt (int initVal) loadbang) <> )
| otherwise = id
rangeJoy :: Bool -> Range Int -> Range Int -> (Int, Int) -> Source (Evt D, Evt D)
rangeJoy isInit rangeX rangeY initVals = mapSource (addInit . f) $ rangeJoySig rangeX rangeY initVals
where
f (x, y) = (snaps x, snaps y)
addInit
| isInit = id
| otherwise = \(a, b) -> (dropE 1 a, dropE 1 b)
rangeJoy2 :: Bool -> Range Int -> Range Int -> (Int, Int) -> Source (Evt (D, D))
rangeJoy2 isInit rangeX rangeY initVals = mapSource (addInit . snaps2) $ rangeJoySig rangeX rangeY initVals
where
addInit
| isInit = id
| otherwise = dropE 1
rangeJoySig :: Range Int -> Range Int -> (Int, Int) -> Source (Sig, Sig)
rangeJoySig rangeX rangeY (initValX, initValY) = mapSource f $
ujoy (toRelativeInitVal rangeX initValX, toRelativeInitVal rangeY initValY)
where f (x, y) = (fromRelative rangeX x, fromRelative rangeY y)
toRelativeInitVal :: Range Int -> Int -> Double
toRelativeInitVal (kmin, kmax) initVal = (fromIntegral $ initVal - kmin) / (fromIntegral $ (kmax - 1) - kmin)
fromRelative :: Range Int -> Sig -> Sig
fromRelative (kmin, kmax) = floor' . uon (f kmin) (f kmax - 0.01)
where f = sig . int
button' :: Tick -> String -> Source Tick
button' ctrl name = mapSource (mappend ctrl) $ button name
toggle' :: Evt D -> String -> Bool -> Source (Evt D)
toggle' ctrl name initVal = source $ do
(gui, output, input) <- unSinkSource $ setToggle name initVal
output ctrl
return $ (gui, mappend ctrl input)
toggleSig' :: Sig -> String -> Bool -> Source Sig
toggleSig' ctrl name initVal =
ctrlSig (if initVal then 1 else 0) ctrl $ setToggleSig name initVal
uknob' :: Sig -> Double -> Source Sig
uknob' ctrl initVal = ctrlSig (double initVal) ctrl $ setKnob "" uspan initVal
uslider' :: Sig -> Double -> Source Sig
uslider' ctrl initVal = ctrlSig (double initVal) ctrl $ setSlider "" uspan initVal
knob' :: Sig -> String -> ValSpan -> Double -> Source Sig
knob' ctrl name span initVal = ctrlSig (double initVal) ctrl $ setKnob name span initVal
slider' :: Sig -> String -> ValSpan -> Double -> Source Sig
slider' ctrl name span initVal = ctrlSig (double initVal) ctrl $ setSlider name span initVal
hradioSig' :: Sig -> [String] -> Int -> Source Sig
hradioSig' = radioGroupSig' hor
vradioSig' :: Sig -> [String] -> Int -> Source Sig
vradioSig' = radioGroupSig' ver
hradio' :: Evt D -> [String] -> Int -> Source (Evt D)
hradio' = radioGroup' hor
vradio' :: Evt D -> [String] -> Int -> Source (Evt D)
vradio' = radioGroup' ver
radioGroup' :: ([Gui] -> Gui) -> Evt D -> [String] -> Int -> Source (Evt D)
radioGroup' gcat ctrl names initVal = mapSource snaps $ radioGroupSig' gcat (evtToSig (int initVal) ctrl) names initVal
radioGroupSig' :: ([Gui] -> Gui) -> Sig -> [String] -> Int -> Source Sig
radioGroupSig' gcat ctrl names initVal = source $ do
(guis, writes, reads) <- fmap unzip3 $ mapM (\(i, tag) -> unSinkSource $ flip setToggleSig (i == initVal) tag) $ zip [0 ..] names
curRef <- newGlobalCtrlRef (sig $ int initVal)
when1 (changed [ctrl] ==* 1) $ writeRef curRef ctrl
current <- readRef curRef
zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids
zipWithM_ (\r i -> runEvt (snaps r) $ \x -> do
when1 (sig x ==* 1) $ do
writeRef curRef i
when1 (sig x ==* 0 &&* current ==* i) $ do
writeRef curRef i
) reads ids
res <- readRef curRef
return (gcat guis, res)
where
ids = fmap (sig . int) [0 .. length names - 1]
ctrlSig :: D -> Sig -> SinkSource Sig -> Source Sig
ctrlSig initVal ctrl v = source $ do
(gui, output, input) <- unSinkSource v
ref <- newGlobalCtrlRef (sig initVal)
when1 (changed [ctrl] ==* 1) $ writeRef ref ctrl
when1 (changed [input] ==* 1) $ writeRef ref input
res <- readRef ref
output res
return (gui, res)