{-# Language
TypeSynonymInstances,
FlexibleInstances,
MultiParamTypeClasses,
FlexibleContexts,
TypeFamilies #-}
module Csound.Control.Gui (
Gui,
Widget, Input, Output, Inner,
Sink(..), Source(..), Display(..), SinkSource(..),
widget, sink, source, display, sinkSource, sinkSlice, sourceSlice,
mapSource, mapGuiSource,
mhor, mver, msca,
joinSource, fromSource, fromSourceSE, resizeSource,
panel, win, panels, panelBy,
keyPanel, keyWin, keyPanels, keyPanelBy,
module Csound.Control.Gui.Layout,
module Csound.Control.Gui.Props,
module Csound.Control.Gui.Widget,
hlifts, vlifts, gridLifts,
lift1, hlift2, vlift2, hlift3, vlift3, hlift4, vlift4, hlift5, vlift5,
hlifts', vlifts',
hlift2', vlift2', hlift3', vlift3', hlift4', vlift4', hlift5', vlift5',
hbind, vbind, happly, vapply, hmapM, vmapM,
hbind', vbind', happly', vapply', hmapM', vmapM', gridMapM
) where
import Control.Monad
import Csound.Typed
import Csound.Typed.Gui
import Csound.Control.Gui.Layout
import Csound.Control.Gui.Props
import Csound.Control.Gui.Widget
import Csound.SigSpace
instance SigSpace a => SigSpace (Source a) where
mapSig f = mapSource (mapSig f)
instance (At Sig (SE Sig) a) => At Sig (SE Sig) (Source a) where
type AtOut Sig (SE Sig) (Source a) = Source (AtOut Sig (SE Sig) a)
at f a = mapSource (at f) a
instance (At Sig2 Sig2 a) => At Sig2 Sig2 (Source a) where
type AtOut Sig2 Sig2 (Source a) = Source (AtOut Sig2 Sig2 a)
at f a = mapSource (at f) a
instance (At Sig2 (SE Sig2) a) => At Sig2 (SE Sig2) (Source a) where
type AtOut Sig2 (SE Sig2) (Source a) = Source (AtOut Sig2 (SE Sig2) a)
at f a = mapSource (at f) a
win :: String -> (Int, Int) -> Gui -> SE ()
win name (x, y) = panelBy name (Just $ Rect 0 0 x y)
keyWin :: String -> (Int, Int) -> Gui -> SE ()
keyWin name (x, y) = keyPanelBy name (Just $ Rect 0 0 x y)
joinSource :: Source (SE a) -> Source a
joinSource a = Source $ do
(g, mv) <- unSource a
v <- mv
return (g, v)
fromSource :: Source a -> SE a
fromSource a = do
(gui, asig) <- unSource a
panel gui
return asig
fromSourceSE :: Source (SE a) -> SE a
fromSourceSE = join . fromSource
resizeSource :: (Double, Double) -> Source a -> Source a
resizeSource scaleXY = mapGuiSource $ resizeGui scaleXY
hlifts :: ([a] -> b) -> [Source a] -> Source b
hlifts = genLifts hor
vlifts :: ([a] -> b) -> [Source a] -> Source b
vlifts = genLifts ver
gridLifts :: Int -> ([a] -> b) -> [Source a] -> Source b
gridLifts rowLength = genLifts (grid rowLength)
hlifts' :: [Double] -> ([a] -> b) -> [Source a] -> Source b
hlifts' props = genLifts (applyProportionsToList props hor)
vlifts' :: [Double] -> ([a] -> b) -> [Source a] -> Source b
vlifts' props = genLifts (applyProportionsToList props ver)
applyProportionsToList :: [Double] -> ([Gui] -> Gui) -> [Gui] -> Gui
applyProportionsToList props f as = f $ zipWith sca (props ++ repeat 1) as
genLifts :: ([Gui] -> Gui) -> ([a] -> b) -> [Source a] -> Source b
genLifts gf f as = Source $ fmap phi $ mapM unSource as
where
phi xs = (gf gs, f vs)
where (gs, vs) = unzip xs
lift1 :: (a -> b) -> Source a -> Source b
lift1 = mapSource
lift2 :: (Gui -> Gui -> Gui) -> (a -> b -> c) -> Source a -> Source b -> Source c
lift2 gf f ma mb = source $ do
(ga, a) <- unSource ma
(gb, b) <- unSource mb
return $ (gf ga gb, f a b)
lift2' a b gf = lift2 (tfm2 a b gf)
where tfm2 sa sb gf = \a b -> gf (sca sa a) (sca sb b)
hlift2 :: (a -> b -> c) -> Source a -> Source b -> Source c
hlift2 = lift2 (\a b -> hor [a, b])
vlift2 :: (a -> b -> c) -> Source a -> Source b -> Source c
vlift2 = lift2 (\a b -> ver [a, b])
hlift2' :: Double -> Double -> (a -> b -> c) -> Source a -> Source b -> Source c
hlift2' sa sb = lift2' sa sb (\a b -> hor [a, b])
vlift2' :: Double -> Double -> (a -> b -> c) -> Source a -> Source b -> Source c
vlift2' sa sb = lift2' sa sb (\a b -> ver [a, b])
lift3 :: (Gui -> Gui -> Gui -> Gui) -> (a -> b -> c -> d) -> Source a -> Source b -> Source c -> Source d
lift3 gf f ma mb mc = source $ do
(ga, a) <- unSource $ ma
(gb, b) <- unSource $ mb
(gc, c) <- unSource $ mc
return $ (gf ga gb gc, f a b c)
lift3' sa sb sc gf = lift3 (tfm3 sa sb sc gf)
where tfm3 sa sb sc gf = \a b c -> gf (sca sa a) (sca sb b) (sca sc c)
hlift3 :: (a -> b -> c -> d) -> Source a -> Source b -> Source c -> Source d
hlift3 = lift3 (\a b c -> hor [a, b, c])
vlift3 :: (a -> b -> c -> d) -> Source a -> Source b -> Source c -> Source d
vlift3 = lift3 (\a b c -> ver [a, b, c])
hlift3' :: Double -> Double -> Double -> (a -> b -> c -> d) -> Source a -> Source b -> Source c -> Source d
hlift3' a b c = lift3' a b c (\a b c -> hor [a, b, c])
vlift3' :: Double -> Double -> Double -> (a -> b -> c -> d) -> Source a -> Source b -> Source c -> Source d
vlift3' a b c = lift3' a b c (\a b c -> ver [a, b, c])
lift4 :: (Gui -> Gui -> Gui -> Gui -> Gui) -> (a -> b -> c -> d -> e) -> Source a -> Source b -> Source c -> Source d -> Source e
lift4 gf f ma mb mc md = source $ do
(ga, a) <- unSource $ ma
(gb, b) <- unSource $ mb
(gc, c) <- unSource $ mc
(gd, d) <- unSource $ md
return $ (gf ga gb gc gd, f a b c d)
lift4' sa sb sc sd gf = lift4 (tfm3 sa sb sc sd gf)
where tfm3 sa sb sc sd gf = \a b c d -> gf (sca sa a) (sca sb b) (sca sc c) (sca sd d)
hlift4 :: (a -> b -> c -> d -> e) -> Source a -> Source b -> Source c -> Source d -> Source e
hlift4 = lift4 (\a b c d -> hor [a, b, c, d])
vlift4 :: (a -> b -> c -> d -> e) -> Source a -> Source b -> Source c -> Source d -> Source e
vlift4 = lift4 (\a b c d -> ver [a, b, c, d])
hlift4' :: Double -> Double -> Double -> Double -> (a -> b -> c -> d -> e) -> Source a -> Source b -> Source c -> Source d -> Source e
hlift4' a b c d = lift4' a b c d (\a b c d -> hor [a, b, c, d])
vlift4' :: Double -> Double -> Double -> Double -> (a -> b -> c -> d -> e) -> Source a -> Source b -> Source c -> Source d -> Source e
vlift4' a b c d = lift4' a b c d (\a b c d -> ver [a, b, c, d])
lift5 :: (Gui -> Gui -> Gui -> Gui -> Gui -> Gui) -> (a1 -> a2 -> a3 -> a4 -> a5 -> b) -> Source a1 -> Source a2 -> Source a3 -> Source a4 -> Source a5 -> Source b
lift5 gf f ma1 ma2 ma3 ma4 ma5 = source $ do
(ga1, a1) <- unSource $ ma1
(ga2, a2) <- unSource $ ma2
(ga3, a3) <- unSource $ ma3
(ga4, a4) <- unSource $ ma4
(ga5, a5) <- unSource $ ma5
return $ (gf ga1 ga2 ga3 ga4 ga5, f a1 a2 a3 a4 a5)
lift5' sa sb sc sd se gf = lift5 (tfm3 sa sb sc sd se gf)
where tfm3 sa sb sc sd se gf = \a b c d e -> gf (sca sa a) (sca sb b) (sca sc c) (sca sd d) (sca se e)
hlift5 :: (a1 -> a2 -> a3 -> a4 -> a5 -> b) -> Source a1 -> Source a2 -> Source a3 -> Source a4 -> Source a5 -> Source b
hlift5 = lift5 (\a b c d e -> hor [a, b, c, d, e])
vlift5 :: (a1 -> a2 -> a3 -> a4 -> a5 -> b) -> Source a1 -> Source a2 -> Source a3 -> Source a4 -> Source a5 -> Source b
vlift5 = lift5 (\a b c d e -> ver [a, b, c, d, e])
hlift5' :: Double -> Double -> Double -> Double -> Double -> (a1 -> a2 -> a3 -> a4 -> a5 -> b) -> Source a1 -> Source a2 -> Source a3 -> Source a4 -> Source a5 -> Source b
hlift5' a b c d e = lift5' a b c d e (\a b c d e -> hor [a, b, c, d, e])
vlift5' :: Double -> Double -> Double -> Double -> Double -> (a1 -> a2 -> a3 -> a4 -> a5 -> b) -> Source a1 -> Source a2 -> Source a3 -> Source a4 -> Source a5 -> Source b
vlift5' a b c d e = lift5' a b c d e (\a b c d e -> ver [a, b, c, d, e])
hbind :: Source a -> (a -> Source b) -> Source b
hbind = genBind (\a b -> hor [a, b])
vbind :: Source a -> (a -> Source b) -> Source b
vbind = genBind (\a b -> ver [a, b])
happly :: (a -> Source b) -> Source a -> Source b
happly = flip $ genBind (\a b -> hor [b, a])
vapply :: (a -> Source b) -> Source a -> Source b
vapply = flip $ genBind (\a b -> ver [b, a])
hbind' :: Double -> Double -> Source a -> (a -> Source b) -> Source b
hbind' ka kb = genBind (\a b -> hor [sca ka a, sca kb b])
vbind' :: Double -> Double -> Source a -> (a -> Source b) -> Source b
vbind' ka kb = genBind (\a b -> ver [sca ka a, sca kb b])
happly' :: Double -> Double -> (a -> Source b) -> Source a -> Source b
happly' ka kb = flip $ genBind (\a b -> hor [sca kb b, sca ka a])
vapply' :: Double -> Double -> (a -> Source b) -> Source a -> Source b
vapply' ka kb = flip $ genBind (\a b -> ver [sca kb b, sca ka a])
genBind :: (Gui -> Gui -> Gui) -> Source a -> (a -> Source b) -> Source b
genBind gui ma mf = source $ do
(ga, a) <- unSource ma
(gb, b) <- unSource $ mf a
return (gui ga gb, b)
hmapM :: (a -> Source b) -> [a] -> Source [b]
hmapM = genMapM hor
vmapM :: (a -> Source b) -> [a] -> Source [b]
vmapM = genMapM ver
hmapM' :: [Double] -> (a -> Source b) -> [a] -> Source [b]
hmapM' ks = genMapM (\xs -> hor $ zipWith sca ks xs)
vmapM' :: [Double] -> (a -> Source b) -> [a] -> Source [b]
vmapM' ks = genMapM (\xs -> ver $ zipWith sca ks xs)
gridMapM :: Int -> (a -> Source b) -> [a] -> Source [b]
gridMapM rowLength = genMapM (grid rowLength)
genMapM :: ([Gui] -> Gui) -> (a -> Source b) -> [a] -> Source [b]
genMapM gui f xs = source $ do
(gs, vs) <- fmap unzip $ mapM (unSource . f) xs
return (gui gs, vs)