-- | Primitive GUI elements.
--
-- There is a convention that constructors take only parameters that
-- specify the logic of the widget. The view is set for GUI-elements with
-- other functions.
module Csound.Control.Gui.Widget (
    -- * Common properties
    ValDiap(..), ValStep, ValScaleType(..), ValSpan(..),
    linSpan, expSpan, uspan, bspan, uspanExp,
    -- * Valuators
    count, countSig, joy,
    knob, KnobType(..), setKnobType,
    roller,
    slider, sliderBank, SliderType(..), setSliderType,
    numeric, TextType(..), setTextType,

    -- * Other widgets
    box, BoxType(..), setBoxType,
    button, ButtonType(..), setButtonType,
    toggle, butBank, toggleSig, butBankSig,
    butBank1, butBankSig1,
    radioButton, matrixButton, funnyRadio, funnyMatrix,
    setNumeric, meter,
    setKnob, setSlider,
    setToggle, setToggleSig,
    -- * Transformers
    setTitle,
    -- * Keyboard
    KeyEvt(..), Key(..), keyIn, charOn, charOff, strOn, strOff,

    -- * Easy to use widgets
    uknob, xknob, uslider, xslider, ujoy,
    hradio, vradio, hradioSig, vradioSig,

    -- * Number selectors
    -- | Widgets for sample and hold functions
    hnumbers, vnumbers,

    -- * Range widgets
    Range,
    rangeKnob, rangeSlider, rangeKnobSig, rangeSliderSig,
    rangeJoy, rangeJoy2, rangeJoySig,

    -- * The 2D matrix of widgets
    knobPad, togglePad, buttonPad, genPad,

    -- * External control

    -- | The widgets can be controlled with external signals/event streams
    button', toggle', toggleSig', knob', slider', uknob', uslider',
    hradio', vradio', hradioSig', vradioSig'
) where

import Prelude hiding (span, reads)

import Control.Monad

import Data.List(transpose)
import Data.Boolean

import Csound.Typed.Gui hiding (widget, height, width)
import Csound.Typed.Types
import Csound.Control.SE
import Csound.Control.Evt(listAt, Tick, snaps2, dropE, devt, loadbang, evtToSig)
import Csound.Typed.Opcode(changed)

--------------------------------------------------------------------
-- aux widgets

readMatrix :: Int -> Int -> [a] -> [a]
readMatrix :: Int -> Int -> [a] -> [a]
readMatrix Int
xn Int
yn [a]
as = [a] -> [a]
forall a. [a] -> [a]
transp ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int
xn Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
yn) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a -> [a]
forall a. a -> [a]
repeat ([a] -> a
forall a. [a] -> a
head [a]
as)
    where
        transp :: [a] -> [a]
transp [a]
xs = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [a] -> [[a]]
forall t a. (Eq t, Num t) => t -> Int -> [a] -> [[a]]
parts Int
yn Int
xn [a]
xs
        parts :: t -> Int -> [a] -> [[a]]
parts t
x Int
y [a]
qs
            | t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0    = []
            | Bool
otherwise = [a]
a [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: t -> Int -> [a] -> [[a]]
parts (t
x t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Int
y [a]
b
            where ([a]
a, [a]
b) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
y [a]
qs

-- | A radio button. It takes a list of values with labels.
radioButton :: Arg a => String -> [(String, a)] -> Int -> Source (Evt a)
radioButton :: String -> [(String, a)] -> Int -> Source (Evt a)
radioButton String
title [(String, a)]
as Int
initVal = Source (Evt a) -> Source (Evt a)
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source (Evt a) -> Source (Evt a))
-> Source (Evt a) -> Source (Evt a)
forall a b. (a -> b) -> a -> b
$ do
    (Gui
g, Input (Evt D)
ind) <- String -> Int -> Int -> (Int, Int) -> Source (Input (Evt D))
butBank1 String
"" Int
1 ([(String, a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, a)]
as) (Int
0, Int
initVal)
    [Gui]
gnames   <- (String -> SE Gui) -> [String] -> SE [Gui]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> SE Gui
box [String]
names
    let val :: Evt a
val = [a] -> Input (Evt D) -> Evt a
forall a. (Tuple a, Arg a) => [a] -> Input (Evt D) -> Evt a
listAt [a]
vals Input (Evt D)
ind
    Gui
gui <- String -> Gui -> SE Gui
setTitle String
title (Gui -> SE Gui) -> Gui -> SE Gui
forall a b. (a -> b) -> a -> b
$ Int -> Gui -> Gui
padding Int
0 (Gui -> Gui) -> Gui -> Gui
forall a b. (a -> b) -> a -> b
$ [Gui] -> Gui
hor [Double -> Gui -> Gui
sca Double
0.15 Gui
g, [Gui] -> Gui
ver [Gui]
gnames]
    (Gui, Evt a) -> Source (Evt a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Gui
gui, Evt a
val)
    where ([String]
names, [a]
vals) = [(String, a)] -> ([String], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, a)]
as

-- | A matrix of values.
matrixButton :: Arg a => String -> Int -> Int -> [a] -> (Int, Int) -> Source (Evt a)
matrixButton :: String -> Int -> Int -> [a] -> (Int, Int) -> Source (Evt a)
matrixButton String
name Int
xn Int
yn [a]
vals (Int, Int)
initVal = Source (Evt a) -> Source (Evt a)
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source (Evt a) -> Source (Evt a))
-> Source (Evt a) -> Source (Evt a)
forall a b. (a -> b) -> a -> b
$ do
    (Gui
gui, Input (Evt D)
ind) <- String -> Int -> Int -> (Int, Int) -> Source (Input (Evt D))
butBank1 String
name Int
xn Int
yn (Int, Int)
initVal
    let val :: Evt a
val = [a] -> Input (Evt D) -> Evt a
forall a. (Tuple a, Arg a) => [a] -> Input (Evt D) -> Evt a
listAt [a]
allVals Input (Evt D)
ind
    (Gui, Evt a) -> Source (Evt a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Gui
gui, Evt a
val)
    where allVals :: [a]
allVals = Int -> Int -> [a] -> [a]
forall a. Int -> Int -> [a] -> [a]
readMatrix Int
xn Int
yn [a]
vals

-- | Radio button that returns functions. Useful for picking a waveform or type of filter.
funnyRadio :: Tuple b => String -> [(String, a -> b)] -> Int -> Source (a -> b)
funnyRadio :: String -> [(String, a -> b)] -> Int -> Source (a -> b)
funnyRadio String
name [(String, a -> b)]
as Int
initVal = Source (a -> b) -> Source (a -> b)
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source (a -> b) -> Source (a -> b))
-> Source (a -> b) -> Source (a -> b)
forall a b. (a -> b) -> a -> b
$ do
    (Gui
gui, Input (Evt D)
ind) <- String -> [(String, D)] -> Int -> Source (Input (Evt D))
forall a. Arg a => String -> [(String, a)] -> Int -> Source (Evt a)
radioButton String
name ([String] -> [D] -> [(String, D)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
names ((Int -> D) -> [Int] -> [D]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> D
int [Int
0 ..])) Int
initVal
    Sig
contInd <- Sig -> Evt Sig -> SE Sig
forall a. Tuple a => a -> Evt a -> SE a
stepper (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> D
int Int
initVal) (Evt Sig -> SE Sig) -> Evt Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ (D -> Sig) -> Input (Evt D) -> Evt Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap D -> Sig
sig Input (Evt D)
ind
    let instr :: a -> b
instr a
x = [(BoolSig, b)] -> b -> b
forall b. Tuple b => [(BoolSig, b)] -> b -> b
guardedTuple (
                (Int -> (a -> b) -> (BoolSig, b))
-> [Int] -> [a -> b] -> [(BoolSig, b)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
n a -> b
f -> (Sig
contInd Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> D
int Int
n), a -> b
f a
x)) [Int
0 ..] [a -> b]
funs
            ) ([a -> b] -> a -> b
forall a. [a] -> a
head [a -> b]
funs a
x)
    (Gui, a -> b) -> Source (a -> b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Gui
gui, a -> b
instr)
    where ([String]
names, [a -> b]
funs) = [(String, a -> b)] -> ([String], [a -> b])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, a -> b)]
as

-- | Matrix of functional values.
funnyMatrix :: Tuple b => String -> Int -> Int -> [(a -> b)] -> (Int, Int) -> Source (a -> b)
funnyMatrix :: String -> Int -> Int -> [a -> b] -> (Int, Int) -> Source (a -> b)
funnyMatrix String
name Int
xn Int
yn [a -> b]
funs initVal :: (Int, Int)
initVal@(Int
x0, Int
y0) = Source (a -> b) -> Source (a -> b)
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source (a -> b) -> Source (a -> b))
-> Source (a -> b) -> Source (a -> b)
forall a b. (a -> b) -> a -> b
$ do
    (Gui
gui, Input (Evt D)
ind) <- String -> Int -> Int -> (Int, Int) -> Source (Input (Evt D))
butBank1 String
name Int
xn Int
yn (Int, Int)
initVal
    Sig
contInd <- Sig -> Evt Sig -> SE Sig
forall a. Tuple a => a -> Evt a -> SE a
stepper Sig
flattenInitVal (Evt Sig -> SE Sig) -> Evt Sig -> SE Sig
forall a b. (a -> b) -> a -> b
$ (D -> Sig) -> Input (Evt D) -> Evt Sig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap D -> Sig
sig Input (Evt D)
ind
    let instr :: a -> b
instr a
x = [(BoolSig, b)] -> b -> b
forall b. Tuple b => [(BoolSig, b)] -> b -> b
guardedTuple (
                (Int -> (a -> b) -> (BoolSig, b))
-> [Int] -> [a -> b] -> [(BoolSig, b)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
n a -> b
f -> (Sig
contInd Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> D
int Int
n), a -> b
f a
x)) [Int
0 ..] [a -> b]
allFuns
            ) ([a -> b] -> a -> b
forall a. [a] -> a
head [a -> b]
allFuns a
x)
    (Gui, a -> b) -> Source (a -> b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Gui
gui, a -> b
instr)
    where
        allFuns :: [a -> b]
allFuns = Int -> Int -> [a -> b] -> [a -> b]
forall a. Int -> Int -> [a] -> [a]
readMatrix Int
xn Int
yn [a -> b]
funs
        flattenInitVal :: Sig
flattenInitVal = D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ Int
y0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
yn


-- | Shortcut for press 'CharKey' events.
charOn :: Char -> Evt Unit
charOn :: Char -> Evt Unit
charOn  = KeyEvt -> Evt Unit
keyIn (KeyEvt -> Evt Unit) -> (Char -> KeyEvt) -> Char -> Evt Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> KeyEvt
Press   (Key -> KeyEvt) -> (Char -> Key) -> Char -> KeyEvt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Key
CharKey

-- | Shortcut for release 'CharKey' events.
charOff :: Char -> Evt Unit
charOff :: Char -> Evt Unit
charOff = KeyEvt -> Evt Unit
keyIn (KeyEvt -> Evt Unit) -> (Char -> KeyEvt) -> Char -> Evt Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> KeyEvt
Release (Key -> KeyEvt) -> (Char -> Key) -> Char -> KeyEvt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Key
CharKey

-- | Creates an event in the output stream when one of the chars is pressed.
strOn :: String -> Tick
strOn :: String -> Evt Unit
strOn String
a = [Evt Unit] -> Evt Unit
forall a. Monoid a => [a] -> a
mconcat ([Evt Unit] -> Evt Unit) -> [Evt Unit] -> Evt Unit
forall a b. (a -> b) -> a -> b
$ (Char -> Evt Unit) -> String -> [Evt Unit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Evt Unit
charOn String
a

-- | Creates an event in the output stream when one of the chars is depressed.
strOff :: String -> Tick
strOff :: String -> Evt Unit
strOff String
a = [Evt Unit] -> Evt Unit
forall a. Monoid a => [a] -> a
mconcat ([Evt Unit] -> Evt Unit) -> [Evt Unit] -> Evt Unit
forall a b. (a -> b) -> a -> b
$ (Char -> Evt Unit) -> String -> [Evt Unit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Evt Unit
charOff String
a

-- | Unipolar linear slider. The value belongs to the interval [0, 1].
-- The argument is for initial value.
uslider :: Double -> Source Sig
uslider :: Double -> Source Sig
uslider = String -> ValSpan -> Double -> Source Sig
slider String
"" (Double -> Double -> ValSpan
linSpan Double
0 Double
1)

-- | Unipolar linear knob. The value belongs to the interval [0, 1].
-- The argument is for initial value.
uknob :: Double -> Source Sig
uknob :: Double -> Source Sig
uknob = String -> ValSpan -> Double -> Source Sig
knob String
"" (Double -> Double -> ValSpan
linSpan Double
0 Double
1)

-- | Exponential slider (usefull for exploring frequencies or decibels).
--
-- > xknob (min, max) initVal
--
-- The value belongs to the interval [min, max].
-- The last argument is for initial value.
xslider :: Range Double -> Double -> Source Sig
xslider :: Range Double -> Double -> Source Sig
xslider (Double
a, Double
b) Double
initVal = String -> ValSpan -> Double -> Source Sig
slider String
"" (Double -> Double -> ValSpan
expSpan Double
a Double
b) Double
initVal

-- | Exponential knob (usefull for exploring frequencies or decibels).
--
-- > xknob (min, max) initVal
--
-- The value belongs to the interval [min, max].
-- The last argument is for initial value.
xknob :: Range Double -> Double -> Source Sig
xknob :: Range Double -> Double -> Source Sig
xknob (Double
a, Double
b) Double
initVal = String -> ValSpan -> Double -> Source Sig
knob String
"" (Double -> Double -> ValSpan
expSpan Double
a Double
b) Double
initVal

-- | Unit linear joystick.
ujoy :: (Double, Double) -> Source (Sig, Sig)
ujoy :: Range Double -> Source (Sig, Sig)
ujoy = ValSpan -> ValSpan -> Range Double -> Source (Sig, Sig)
joy (Double -> Double -> ValSpan
linSpan Double
0 Double
1) (Double -> Double -> ValSpan
linSpan Double
0 Double
1)

---------------------------------------------------------------
-- sample and hold

-- | The sample and hold widget. You can pick a value from the list of doubles.
-- The original value is a head of the list (the first element).
-- The visual grouping is horizontal (notice the prefix @h@).
-- It's common to use it with function @selector@.
hnumbers :: [Double] -> Source Sig
hnumbers :: [Double] -> Source Sig
hnumbers = ([Gui] -> Gui) -> [Double] -> Source Sig
genNumbers [Gui] -> Gui
hor

-- | The sample and hold widget. You can pick a value from the list of doubles.
-- The original value is a head of the list (the first element).
-- The visual grouping is vertical (notice the prefix @v@).
-- It's common to use it with function @selector@.
vnumbers :: [Double] -> Source Sig
vnumbers :: [Double] -> Source Sig
vnumbers = ([Gui] -> Gui) -> [Double] -> Source Sig
genNumbers [Gui] -> Gui
ver

genNumbers :: ([Gui] -> Gui) -> [Double] -> Source Sig
genNumbers :: ([Gui] -> Gui) -> [Double] -> Source Sig
genNumbers [Gui] -> Gui
gx as :: [Double]
as@(Double
d:[Double]
_) = Source Sig -> Source Sig
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source Sig -> Source Sig) -> Source Sig -> Source Sig
forall a b. (a -> b) -> a -> b
$ do
    Ref Sig
ref <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newGlobalCtrlRef (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Double -> D
double Double
d)
    ([Gui]
gs, [Evt Unit]
evts) <- ([(Gui, Evt Unit)] -> ([Gui], [Evt Unit]))
-> SE [(Gui, Evt Unit)] -> SE ([Gui], [Evt Unit])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Evt Unit)] -> ([Gui], [Evt Unit])
forall a b. [(a, b)] -> ([a], [b])
unzip (SE [(Gui, Evt Unit)] -> SE ([Gui], [Evt Unit]))
-> SE [(Gui, Evt Unit)] -> SE ([Gui], [Evt Unit])
forall a b. (a -> b) -> a -> b
$ (Double -> SE (Gui, Evt Unit)) -> [Double] -> SE [(Gui, Evt Unit)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> SE (Gui, Evt Unit)
button (String -> SE (Gui, Evt Unit))
-> (Double -> String) -> Double -> SE (Gui, Evt Unit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) [Double]
as
    (Double -> Evt Unit -> SE ()) -> [Double] -> [Evt Unit] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Double
x Evt Unit
e -> Evt Unit -> Bam Unit -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt Evt Unit
e (Bam Unit -> SE ()) -> Bam Unit -> SE ()
forall a b. (a -> b) -> a -> b
$ \Unit
_ -> Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
ref (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Double -> D
double Double
x)) [Double]
as [Evt Unit]
evts
    Sig
res <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
ref
    (Gui, Sig) -> Source Sig
forall (m :: * -> *) a. Monad m => a -> m a
return ([Gui] -> Gui
gx [Gui]
gs, Sig
res)
genNumbers [Gui] -> Gui
_ [] = String -> Source Sig
forall a. HasCallStack => String -> a
error String
"Not implemented for empty list"


-------------------------------------------------------------------
-- 2D matrix of widgets

-- | The matrix of unipolar knobs.
--
-- > knobPad columnNum rowNum names initVals
--
-- It takes in the dimensions of matrix, the names (we can leave it empty
-- if names are not important) and list of init values.
-- It returns a function that takes in indices and produces the signal in
-- the corresponding cell.
knobPad :: Int -> Int -> [String] -> [Double] -> Source (Int -> Int -> Sig)
knobPad :: Int -> Int -> [String] -> [Double] -> Source (Int -> Int -> Sig)
knobPad = (String -> Double -> Source Sig)
-> Double
-> Int
-> Int
-> [String]
-> [Double]
-> Source (Int -> Int -> Sig)
forall a b.
(String -> a -> Source b)
-> a -> Int -> Int -> [String] -> [a] -> Source (Int -> Int -> b)
genPad String -> Double -> Source Sig
mkKnob Double
0.5
    where mkKnob :: String -> Double -> Source Sig
mkKnob String
name = String -> ValSpan -> Double -> Source Sig
knob String
name ValSpan
uspan

-- | The matrix of toggle buttons.
--
-- > togglePad columnNum rowNum names initVals
--
-- It takes in the dimensions of matrix, the names (we can leave it empty
-- if names are not important) and list of init values (on/off booleans).
-- It returns a function that takes in indices and produces the event stream in
-- the corresponding cell.
togglePad :: Int -> Int -> [String] -> [Bool] -> Source (Int -> Int -> Evt D)
togglePad :: Int
-> Int
-> [String]
-> [Bool]
-> Source (Int -> Int -> Input (Evt D))
togglePad = (String -> Bool -> Source (Input (Evt D)))
-> Bool
-> Int
-> Int
-> [String]
-> [Bool]
-> Source (Int -> Int -> Input (Evt D))
forall a b.
(String -> a -> Source b)
-> a -> Int -> Int -> [String] -> [a] -> Source (Int -> Int -> b)
genPad String -> Bool -> Source (Input (Evt D))
toggle Bool
False

-- | The matrix of buttons.
--
-- > buttonPad columnNum rowNum names
--
-- It takes in the dimensions of matrix, the names (we can leave it empty
-- if names are not important).
-- It returns a function that takes in indices and produces the event stream in
-- the corresponding cell.
buttonPad :: Int -> Int -> [String] -> Source (Int -> Int -> Evt Unit)
buttonPad :: Int -> Int -> [String] -> Source (Int -> Int -> Evt Unit)
buttonPad Int
width Int
height [String]
names = (String -> Bool -> SE (Gui, Evt Unit))
-> Bool
-> Int
-> Int
-> [String]
-> [Bool]
-> Source (Int -> Int -> Evt Unit)
forall a b.
(String -> a -> Source b)
-> a -> Int -> Int -> [String] -> [a] -> Source (Int -> Int -> b)
genPad String -> Bool -> SE (Gui, Evt Unit)
forall p. String -> p -> SE (Gui, Evt Unit)
mkButton Bool
False Int
width Int
height [String]
names []
    where mkButton :: String -> p -> SE (Gui, Evt Unit)
mkButton String
name p
_ = String -> SE (Gui, Evt Unit)
button String
name

-- | A generic constructor for matrixes of sound source widgets.
-- It takes the constructor of the widget, a default initial value,
-- the dimensions of the matrix, the list of names and the list of initial values.
-- It produces the function that maps indices to corresponding values.
genPad :: (String -> a -> Source b) -> a -> Int -> Int -> [String] -> [a] -> Source (Int -> Int -> b)
genPad :: (String -> a -> Source b)
-> a -> Int -> Int -> [String] -> [a] -> Source (Int -> Int -> b)
genPad String -> a -> Source b
mk a
initVal Int
width Int
height [String]
names [a]
as = Source (Int -> Int -> b) -> Source (Int -> Int -> b)
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source (Int -> Int -> b) -> Source (Int -> Int -> b))
-> Source (Int -> Int -> b) -> Source (Int -> Int -> b)
forall a b. (a -> b) -> a -> b
$ do
    (Gui
gui, [[b]]
vals) <- ([(Gui, [b])] -> (Gui, [[b]]))
-> SE [(Gui, [b])] -> SE (Gui, [[b]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, [b])] -> (Gui, [[b]])
forall b. [(Gui, b)] -> (Gui, [b])
reGroupCol (SE [(Gui, [b])] -> SE (Gui, [[b]]))
-> SE [(Gui, [b])] -> SE (Gui, [[b]])
forall a b. (a -> b) -> a -> b
$ ([(String, a)] -> SE (Gui, [b]))
-> [[(String, a)]] -> SE [(Gui, [b])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [(String, a)] -> SE (Gui, [b])
mkRow [[(String, a)]]
inits
    let f :: Int -> Int -> b
f Int
x Int
y = ([[b]]
vals [[b]] -> Int -> [b]
forall a. [a] -> Int -> a
!! Int
y) [b] -> Int -> b
forall a. [a] -> Int -> a
!! Int
x
    (Gui, Int -> Int -> b) -> Source (Int -> Int -> b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Gui, Int -> Int -> b) -> Source (Int -> Int -> b))
-> (Gui, Int -> Int -> b) -> Source (Int -> Int -> b)
forall a b. (a -> b) -> a -> b
$ (Gui
gui, Int -> Int -> b
f)
    where
        mkRow :: [(String, a)] -> SE (Gui, [b])
mkRow [(String, a)]
xs = ([(Gui, b)] -> (Gui, [b])) -> SE [(Gui, b)] -> SE (Gui, [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, b)] -> (Gui, [b])
forall b. [(Gui, b)] -> (Gui, [b])
reGroupRow (SE [(Gui, b)] -> SE (Gui, [b])) -> SE [(Gui, b)] -> SE (Gui, [b])
forall a b. (a -> b) -> a -> b
$ ((String, a) -> Source b) -> [(String, a)] -> SE [(Gui, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> a -> Source b) -> (String, a) -> Source b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> a -> Source b
mk) [(String, a)]
xs

        inits :: [[(String, a)]]
inits = Int -> Int -> [(String, a)] -> [[(String, a)]]
forall t a. (Eq t, Num t) => t -> Int -> [a] -> [[a]]
split Int
height Int
width ([(String, a)] -> [[(String, a)]])
-> [(String, a)] -> [[(String, a)]]
forall a b. (a -> b) -> a -> b
$ [String] -> [a] -> [(String, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([String]
names [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
forall a. a -> [a]
repeat String
"") ([a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a -> [a]
forall a. a -> [a]
repeat a
initVal)

        split :: t -> Int -> [a] -> [[a]]
split t
m Int
n [a]
xs = case t
m of
            t
0 -> []
            t
a -> (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
xs) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: t -> Int -> [a] -> [[a]]
split (t
a t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Int
n (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
xs)

        reGroupCol :: [(Gui, b)] -> (Gui, [b])
reGroupCol = ([Gui] -> Gui) -> [(Gui, b)] -> (Gui, [b])
forall a a b. ([a] -> a) -> [(a, b)] -> (a, [b])
reGroup [Gui] -> Gui
ver
        reGroupRow :: [(Gui, b)] -> (Gui, [b])
reGroupRow = ([Gui] -> Gui) -> [(Gui, b)] -> (Gui, [b])
forall a a b. ([a] -> a) -> [(a, b)] -> (a, [b])
reGroup [Gui] -> Gui
hor

        reGroup :: ([a] -> a) -> [(a, b)] -> (a, [b])
reGroup [a] -> a
f [(a, b)]
bs = ([a] -> a
f [a]
xs, [b]
ys)
            where ([a]
xs, [b]
ys) = [(a, b)] -> ([a], [b])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, b)]
bs


-- | Horizontal radio group.
hradio :: [String] -> Int -> Source (Evt D)
hradio :: [String] -> Int -> Source (Input (Evt D))
hradio = ([Gui] -> Gui) -> [String] -> Int -> Source (Input (Evt D))
radioGroup [Gui] -> Gui
hor

-- | Vertical radio group.
vradio :: [String] -> Int -> Source (Evt D)
vradio :: [String] -> Int -> Source (Input (Evt D))
vradio = ([Gui] -> Gui) -> [String] -> Int -> Source (Input (Evt D))
radioGroup [Gui] -> Gui
ver

-- | Horizontal radio group.
hradioSig :: [String] -> Int -> Source Sig
hradioSig :: [String] -> Int -> Source Sig
hradioSig = ([Gui] -> Gui) -> [String] -> Int -> Source Sig
radioGroupSig [Gui] -> Gui
hor

-- | Vertical radio group.
vradioSig :: [String] -> Int -> Source Sig
vradioSig :: [String] -> Int -> Source Sig
vradioSig = ([Gui] -> Gui) -> [String] -> Int -> Source Sig
radioGroupSig [Gui] -> Gui
ver

radioGroup :: ([Gui] -> Gui) -> [String] -> Int -> Source (Evt D)
radioGroup :: ([Gui] -> Gui) -> [String] -> Int -> Source (Input (Evt D))
radioGroup [Gui] -> Gui
gcat [String]
names Int
initVal = (Sig -> Input (Evt D)) -> Source Sig -> Source (Input (Evt D))
forall a b. (a -> b) -> Source a -> Source b
mapSource Sig -> Input (Evt D)
snaps (Source Sig -> Source (Input (Evt D)))
-> Source Sig -> Source (Input (Evt D))
forall a b. (a -> b) -> a -> b
$ ([Gui] -> Gui) -> [String] -> Int -> Source Sig
radioGroupSig [Gui] -> Gui
gcat [String]
names Int
initVal

radioGroupSig  :: ([Gui] -> Gui) -> [String] -> Int -> Source Sig
radioGroupSig :: ([Gui] -> Gui) -> [String] -> Int -> Source Sig
radioGroupSig [Gui] -> Gui
gcat [String]
names Int
initVal = Source Sig -> Source Sig
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source Sig -> Source Sig) -> Source Sig -> Source Sig
forall a b. (a -> b) -> a -> b
$ do
    ([Gui]
guis, [Sig -> SE ()]
writes, [Sig]
reads) <- ([(Gui, Sig -> SE (), Sig)] -> ([Gui], [Sig -> SE ()], [Sig]))
-> SE [(Gui, Sig -> SE (), Sig)]
-> SE ([Gui], [Sig -> SE ()], [Sig])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Sig -> SE (), Sig)] -> ([Gui], [Sig -> SE ()], [Sig])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 (SE [(Gui, Sig -> SE (), Sig)]
 -> SE ([Gui], [Sig -> SE ()], [Sig]))
-> SE [(Gui, Sig -> SE (), Sig)]
-> SE ([Gui], [Sig -> SE ()], [Sig])
forall a b. (a -> b) -> a -> b
$ ((Int, String) -> SE (Gui, Sig -> SE (), Sig))
-> [(Int, String)] -> SE [(Gui, Sig -> SE (), Sig)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Int
i, String
tag) -> (String -> Bool -> SE (Gui, Sig -> SE (), Sig))
-> Bool -> String -> SE (Gui, Sig -> SE (), Sig)
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Bool -> SE (Gui, Sig -> SE (), Sig)
setToggleSig (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
initVal) String
tag) ([(Int, String)] -> SE [(Gui, Sig -> SE (), Sig)])
-> [(Int, String)] -> SE [(Gui, Sig -> SE (), Sig)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [String]
names
    Ref Sig
curRef <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newGlobalCtrlRef (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> D
int Int
initVal)
    Sig
current <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
curRef
    ((Sig -> SE ()) -> Sig -> SE ())
-> [Sig -> SE ()] -> [Sig] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Sig -> SE ()
w Sig
i -> Sig -> SE ()
w (Sig -> SE ()) -> Sig -> SE ()
forall a b. (a -> b) -> a -> b
$ BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (Sig
current Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
i) Sig
1 Sig
0) [Sig -> SE ()]
writes [Sig]
ids
    (Sig -> Sig -> SE ()) -> [Sig] -> [Sig] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Sig
r Sig
i -> Input (Evt D) -> Bam D -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt (Sig -> Input (Evt D)
snaps Sig
r) (Bam D -> SE ()) -> Bam D -> SE ()
forall a b. (a -> b) -> a -> b
$ \D
x -> do
        BoolSig -> SE () -> SE ()
when1 (D -> Sig
sig D
x Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
            Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
curRef Sig
i
        BoolSig -> SE () -> SE ()
when1 (D -> Sig
sig D
x Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
0 BoolSig -> BoolSig -> BoolSig
forall b. Boolean b => b -> b -> b
&&* Sig
current Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
i) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
           Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
curRef Sig
i
        ) [Sig]
reads [Sig]
ids

    Sig
res <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
curRef
    (Gui, Sig) -> Source Sig
forall (m :: * -> *) a. Monad m => a -> m a
return ([Gui] -> Gui
gcat [Gui]
guis, Sig
res)
    where
        ids :: [Sig]
ids = (Int -> Sig) -> [Int] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Sig
sig (D -> Sig) -> (Int -> D) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int
0 .. [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
names Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]



-- | Pair of minimum and maximum values.
type Range a = (a, a)

-- | Creates a knob that outputs only integers in the given range.
-- It produces a signal of integer values.
--
-- > rangeKnobSig (min, max) initVal
rangeKnobSig :: Range Int -> Int -> Source Sig
rangeKnobSig :: (Int, Int) -> Int -> Source Sig
rangeKnobSig = (Double -> Source Sig) -> (Int, Int) -> Int -> Source Sig
rangeSig1 Double -> Source Sig
uknob

-- | Creates a slider that outputs only integers in the given range.
-- It produces a signal of integer values.
--
-- > rangeSliderSig (min, max) initVal
rangeSliderSig :: Range Int -> Int -> Source Sig
rangeSliderSig :: (Int, Int) -> Int -> Source Sig
rangeSliderSig = (Double -> Source Sig) -> (Int, Int) -> Int -> Source Sig
rangeSig1 Double -> Source Sig
uslider

-- | Creates a knob that outputs only integers in the given range.
-- It produces an event stream of integer values. It can be used with
-- list access functions @listAt@, @atTuple@, @atArg@.
--
-- > rangeKnob needInit (min, max) initVal
--
-- The first argument is a boolean. If it's true than the initial value
-- is put in the output stream. If it\s False the initial value is skipped.
rangeKnob :: Bool -> Range Int -> Int -> Source (Evt D)
rangeKnob :: Bool -> (Int, Int) -> Int -> Source (Input (Evt D))
rangeKnob = (Double -> Source Sig)
-> Bool -> (Int, Int) -> Int -> Source (Input (Evt D))
rangeEvt1 Double -> Source Sig
uknob

-- | Creates a slider that outputs only integers in the given range.
-- It produces an event stream of integer values. It can be used with
-- list access functions @listAt@, @atTuple@, @atArg@.
--
-- > rangeSlider needInit (min, max) initVal
--
-- The first argument is a boolean. If it's true than the initial value
-- is put in the output stream. If it\s False the initial value is skipped.
rangeSlider :: Bool -> Range Int -> Int -> Source (Evt D)
rangeSlider :: Bool -> (Int, Int) -> Int -> Source (Input (Evt D))
rangeSlider = (Double -> Source Sig)
-> Bool -> (Int, Int) -> Int -> Source (Input (Evt D))
rangeEvt1 Double -> Source Sig
uslider

rangeSig1 :: (Double -> Source Sig) -> Range Int -> Int -> Source Sig
rangeSig1 :: (Double -> Source Sig) -> (Int, Int) -> Int -> Source Sig
rangeSig1 Double -> Source Sig
widget (Int, Int)
range Int
initVal = (Sig -> Sig) -> Source Sig -> Source Sig
forall a b. (a -> b) -> Source a -> Source b
mapSource ((Int, Int) -> Sig -> Sig
fromRelative (Int, Int)
range) (Source Sig -> Source Sig) -> Source Sig -> Source Sig
forall a b. (a -> b) -> a -> b
$ Double -> Source Sig
widget (Double -> Source Sig) -> Double -> Source Sig
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Int -> Double
toRelativeInitVal (Int, Int)
range Int
initVal

rangeEvt1 :: (Double -> Source Sig) -> Bool -> Range Int -> Int -> Source (Evt D)
rangeEvt1 :: (Double -> Source Sig)
-> Bool -> (Int, Int) -> Int -> Source (Input (Evt D))
rangeEvt1 Double -> Source Sig
widget Bool
isInit (Int, Int)
range Int
initVal = (Sig -> Input (Evt D)) -> Source Sig -> Source (Input (Evt D))
forall a b. (a -> b) -> Source a -> Source b
mapSource (Input (Evt D) -> Input (Evt D)
addInit (Input (Evt D) -> Input (Evt D))
-> (Sig -> Input (Evt D)) -> Sig -> Input (Evt D)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Input (Evt D)
snaps) (Source Sig -> Source (Input (Evt D)))
-> Source Sig -> Source (Input (Evt D))
forall a b. (a -> b) -> a -> b
$ (Double -> Source Sig) -> (Int, Int) -> Int -> Source Sig
rangeSig1 Double -> Source Sig
widget (Int, Int)
range Int
initVal
    where
        addInit :: Input (Evt D) -> Input (Evt D)
addInit
            | Bool
isInit    = ((D -> Evt Unit -> Input (Evt D)
forall a. D -> Evt a -> Input (Evt D)
devt (Int -> D
int Int
initVal) Evt Unit
loadbang) Input (Evt D) -> Input (Evt D) -> Input (Evt D)
forall a. Monoid a => a -> a -> a
`mappend` )
            | Bool
otherwise = Input (Evt D) -> Input (Evt D)
forall a. a -> a
id

-- | 2d range range slider. Outputs a pair of event streams.
-- Each stream  contains changes in the given direction (Ox or Oy).
--
-- > rangeJoy needsInit rangeX rangeY (initX, initY)
--
-- The first argument is a boolean. If it's true than the initial value
-- is put in the output stream. If it\s False the initial value is skipped.
rangeJoy :: Bool -> Range Int -> Range Int -> (Int, Int) -> Source (Evt D, Evt D)
rangeJoy :: Bool
-> (Int, Int)
-> (Int, Int)
-> (Int, Int)
-> Source (Input (Evt D), Input (Evt D))
rangeJoy Bool
isInit (Int, Int)
rangeX (Int, Int)
rangeY (Int, Int)
initVals = ((Sig, Sig) -> (Input (Evt D), Input (Evt D)))
-> Source (Sig, Sig) -> Source (Input (Evt D), Input (Evt D))
forall a b. (a -> b) -> Source a -> Source b
mapSource ((Input (Evt D), Input (Evt D)) -> (Input (Evt D), Input (Evt D))
forall a a. (Evt a, Evt a) -> (Evt a, Evt a)
addInit ((Input (Evt D), Input (Evt D)) -> (Input (Evt D), Input (Evt D)))
-> ((Sig, Sig) -> (Input (Evt D), Input (Evt D)))
-> (Sig, Sig)
-> (Input (Evt D), Input (Evt D))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig, Sig) -> (Input (Evt D), Input (Evt D))
f) (Source (Sig, Sig) -> Source (Input (Evt D), Input (Evt D)))
-> Source (Sig, Sig) -> Source (Input (Evt D), Input (Evt D))
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> (Int, Int) -> (Int, Int) -> Source (Sig, Sig)
rangeJoySig (Int, Int)
rangeX (Int, Int)
rangeY (Int, Int)
initVals
    where
        f :: (Sig, Sig) -> (Input (Evt D), Input (Evt D))
f (Sig
x, Sig
y) = (Sig -> Input (Evt D)
snaps Sig
x, Sig -> Input (Evt D)
snaps Sig
y)
        addInit :: (Evt a, Evt a) -> (Evt a, Evt a)
addInit
            | Bool
isInit    = (Evt a, Evt a) -> (Evt a, Evt a)
forall a. a -> a
id
            | Bool
otherwise = \(Evt a
a, Evt a
b) -> (Int -> Evt a -> Evt a
forall a. Int -> Evt a -> Evt a
dropE Int
1 Evt a
a, Int -> Evt a -> Evt a
forall a. Int -> Evt a -> Evt a
dropE Int
1 Evt a
b)

-- | 2d range range slider. It produces a single event stream.
-- The event fires when any signal changes.
--
-- > rangeJoy2 needsInit rangeX rangeY (initX, initY)
--
-- The first argument is a boolean. If it's true than the initial value
-- is put in the output stream. If it\s False the initial value is skipped.
rangeJoy2 :: Bool -> Range Int -> Range Int -> (Int, Int) -> Source (Evt (D, D))
rangeJoy2 :: Bool
-> (Int, Int) -> (Int, Int) -> (Int, Int) -> Source (Evt (D, D))
rangeJoy2 Bool
isInit (Int, Int)
rangeX (Int, Int)
rangeY (Int, Int)
initVals = ((Sig, Sig) -> Evt (D, D))
-> Source (Sig, Sig) -> Source (Evt (D, D))
forall a b. (a -> b) -> Source a -> Source b
mapSource (Evt (D, D) -> Evt (D, D)
forall a. Evt a -> Evt a
addInit (Evt (D, D) -> Evt (D, D))
-> ((Sig, Sig) -> Evt (D, D)) -> (Sig, Sig) -> Evt (D, D)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig, Sig) -> Evt (D, D)
snaps2) (Source (Sig, Sig) -> Source (Evt (D, D)))
-> Source (Sig, Sig) -> Source (Evt (D, D))
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> (Int, Int) -> (Int, Int) -> Source (Sig, Sig)
rangeJoySig (Int, Int)
rangeX (Int, Int)
rangeY (Int, Int)
initVals
    where
        addInit :: Evt a -> Evt a
addInit
            | Bool
isInit    = Evt a -> Evt a
forall a. a -> a
id
            | Bool
otherwise = Int -> Evt a -> Evt a
forall a. Int -> Evt a -> Evt a
dropE Int
1

-- | 2d range range slider. It produces the pair of integer signals
rangeJoySig :: Range Int -> Range Int -> (Int, Int) -> Source (Sig, Sig)
rangeJoySig :: (Int, Int) -> (Int, Int) -> (Int, Int) -> Source (Sig, Sig)
rangeJoySig (Int, Int)
rangeX (Int, Int)
rangeY (Int
initValX, Int
initValY) = ((Sig, Sig) -> (Sig, Sig))
-> Source (Sig, Sig) -> Source (Sig, Sig)
forall a b. (a -> b) -> Source a -> Source b
mapSource (Sig, Sig) -> (Sig, Sig)
f (Source (Sig, Sig) -> Source (Sig, Sig))
-> Source (Sig, Sig) -> Source (Sig, Sig)
forall a b. (a -> b) -> a -> b
$
    Range Double -> Source (Sig, Sig)
ujoy ((Int, Int) -> Int -> Double
toRelativeInitVal (Int, Int)
rangeX Int
initValX, (Int, Int) -> Int -> Double
toRelativeInitVal (Int, Int)
rangeY Int
initValY)
    where f :: (Sig, Sig) -> (Sig, Sig)
f (Sig
x, Sig
y) = ((Int, Int) -> Sig -> Sig
fromRelative (Int, Int)
rangeX Sig
x, (Int, Int) -> Sig -> Sig
fromRelative (Int, Int)
rangeY Sig
y)

toRelativeInitVal :: Range Int -> Int -> Double
toRelativeInitVal :: (Int, Int) -> Int -> Double
toRelativeInitVal (Int
kmin, Int
kmax) Int
initVal = (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Int
initVal Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
kmin) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ (Int
kmax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
kmin)

fromRelative :: Range Int -> Sig -> Sig
fromRelative :: (Int, Int) -> Sig -> Sig
fromRelative (Int
kmin, Int
kmax) = Sig -> Sig
forall a. SigOrD a => a -> a
floor' (Sig -> Sig) -> (Sig -> Sig) -> Sig -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Sig -> Sig -> Sig
forall a. SigSpace a => Sig -> Sig -> a -> a
uon (Int -> Sig
f Int
kmin) (Int -> Sig
f Int
kmax Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
0.01)
    where f :: Int -> Sig
f = D -> Sig
sig (D -> Sig) -> (Int -> D) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int


------------------------------------------------------------
-- external control of widgets

-- | It's like simple @button@, but it can be controlled with external control.
-- The first argument is for external control.
button' :: Tick -> String -> Source Tick
button' :: Evt Unit -> String -> SE (Gui, Evt Unit)
button' Evt Unit
ctrl String
name = (Evt Unit -> Evt Unit) -> SE (Gui, Evt Unit) -> SE (Gui, Evt Unit)
forall a b. (a -> b) -> Source a -> Source b
mapSource (Evt Unit -> Evt Unit -> Evt Unit
forall a. Monoid a => a -> a -> a
mappend Evt Unit
ctrl) (SE (Gui, Evt Unit) -> SE (Gui, Evt Unit))
-> SE (Gui, Evt Unit) -> SE (Gui, Evt Unit)
forall a b. (a -> b) -> a -> b
$ String -> SE (Gui, Evt Unit)
button String
name

-- | It's like simple @toggle@, but it can be controlled with external control.
-- The first argument is for external control.
toggle' :: Evt D -> String -> Bool -> Source (Evt D)
toggle' :: Input (Evt D) -> String -> Bool -> Source (Input (Evt D))
toggle' Input (Evt D)
ctrl String
name Bool
initVal = Source (Input (Evt D)) -> Source (Input (Evt D))
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source (Input (Evt D)) -> Source (Input (Evt D)))
-> Source (Input (Evt D)) -> Source (Input (Evt D))
forall a b. (a -> b) -> a -> b
$ do
    (Gui
gui, Output (Input (Evt D))
output, Input (Evt D)
input) <- String -> Bool -> SinkSource (Input (Evt D))
setToggle String
name Bool
initVal
    Output (Input (Evt D))
output Input (Evt D)
ctrl
    (Gui, Input (Evt D)) -> Source (Input (Evt D))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Gui, Input (Evt D)) -> Source (Input (Evt D)))
-> (Gui, Input (Evt D)) -> Source (Input (Evt D))
forall a b. (a -> b) -> a -> b
$ (Gui
gui, Input (Evt D) -> Input (Evt D) -> Input (Evt D)
forall a. Monoid a => a -> a -> a
mappend Input (Evt D)
ctrl Input (Evt D)
input)

toggleSig' :: Sig -> String -> Bool -> Source Sig
toggleSig' :: Sig -> String -> Bool -> Source Sig
toggleSig' Sig
ctrl String
name Bool
initVal =
    D -> Sig -> SE (Gui, Sig -> SE (), Sig) -> Source Sig
ctrlSig (if Bool
initVal then D
1 else D
0) Sig
ctrl (SE (Gui, Sig -> SE (), Sig) -> Source Sig)
-> SE (Gui, Sig -> SE (), Sig) -> Source Sig
forall a b. (a -> b) -> a -> b
$ String -> Bool -> SE (Gui, Sig -> SE (), Sig)
setToggleSig String
name Bool
initVal

-- | It's like simple @uknob@, but it can be controlled with external control.
-- The first argument is for external control.
uknob' :: Sig -> Double -> Source Sig
uknob' :: Sig -> Double -> Source Sig
uknob' Sig
ctrl Double
initVal = D -> Sig -> SE (Gui, Sig -> SE (), Sig) -> Source Sig
ctrlSig (Double -> D
double Double
initVal) Sig
ctrl (SE (Gui, Sig -> SE (), Sig) -> Source Sig)
-> SE (Gui, Sig -> SE (), Sig) -> Source Sig
forall a b. (a -> b) -> a -> b
$ String -> ValSpan -> Double -> SE (Gui, Sig -> SE (), Sig)
setKnob String
"" ValSpan
uspan Double
initVal

-- | It's like simple @uslider@, but it can be controlled with external control.
-- The first argument is for external control.
uslider' :: Sig -> Double -> Source Sig
uslider' :: Sig -> Double -> Source Sig
uslider' Sig
ctrl Double
initVal = D -> Sig -> SE (Gui, Sig -> SE (), Sig) -> Source Sig
ctrlSig (Double -> D
double Double
initVal) Sig
ctrl (SE (Gui, Sig -> SE (), Sig) -> Source Sig)
-> SE (Gui, Sig -> SE (), Sig) -> Source Sig
forall a b. (a -> b) -> a -> b
$ String -> ValSpan -> Double -> SE (Gui, Sig -> SE (), Sig)
setSlider String
"" ValSpan
uspan Double
initVal

-- | It's like simple @knob@, but it can be controlled with external control.
-- The first argument is for external control.
knob' :: Sig -> String -> ValSpan -> Double -> Source Sig
knob' :: Sig -> String -> ValSpan -> Double -> Source Sig
knob' Sig
ctrl String
name ValSpan
span Double
initVal = D -> Sig -> SE (Gui, Sig -> SE (), Sig) -> Source Sig
ctrlSig (Double -> D
double Double
initVal) Sig
ctrl (SE (Gui, Sig -> SE (), Sig) -> Source Sig)
-> SE (Gui, Sig -> SE (), Sig) -> Source Sig
forall a b. (a -> b) -> a -> b
$ String -> ValSpan -> Double -> SE (Gui, Sig -> SE (), Sig)
setKnob String
name ValSpan
span Double
initVal

-- | It's like simple @slider@, but it can be controlled with external control.
-- The first argument is for external control.
slider' :: Sig -> String -> ValSpan -> Double -> Source Sig
slider' :: Sig -> String -> ValSpan -> Double -> Source Sig
slider' Sig
ctrl String
name ValSpan
span Double
initVal = D -> Sig -> SE (Gui, Sig -> SE (), Sig) -> Source Sig
ctrlSig (Double -> D
double Double
initVal) Sig
ctrl (SE (Gui, Sig -> SE (), Sig) -> Source Sig)
-> SE (Gui, Sig -> SE (), Sig) -> Source Sig
forall a b. (a -> b) -> a -> b
$ String -> ValSpan -> Double -> SE (Gui, Sig -> SE (), Sig)
setSlider String
name ValSpan
span Double
initVal

-- | It's like simple @hradioSig@, but it can be controlled with external control.
-- The first argument is for external control.
hradioSig' :: Sig -> [String] -> Int -> Source Sig
hradioSig' :: Sig -> [String] -> Int -> Source Sig
hradioSig' = ([Gui] -> Gui) -> Sig -> [String] -> Int -> Source Sig
radioGroupSig' [Gui] -> Gui
hor

-- | It's like simple @vradioSig@, but it can be controlled with external control.
-- The first argument is for external control.
vradioSig' :: Sig -> [String] -> Int -> Source Sig
vradioSig' :: Sig -> [String] -> Int -> Source Sig
vradioSig' = ([Gui] -> Gui) -> Sig -> [String] -> Int -> Source Sig
radioGroupSig' [Gui] -> Gui
ver

-- | It's like simple @hradio@, but it can be controlled with external control.
-- The first argument is for external control.
hradio' :: Evt D -> [String] -> Int -> Source (Evt D)
hradio' :: Input (Evt D) -> [String] -> Int -> Source (Input (Evt D))
hradio' = ([Gui] -> Gui)
-> Input (Evt D) -> [String] -> Int -> Source (Input (Evt D))
radioGroup' [Gui] -> Gui
hor

-- | It's like simple @vradio@, but it can be controlled with external control.
-- The first argument is for external control.
vradio' :: Evt D -> [String] -> Int -> Source (Evt D)
vradio' :: Input (Evt D) -> [String] -> Int -> Source (Input (Evt D))
vradio' = ([Gui] -> Gui)
-> Input (Evt D) -> [String] -> Int -> Source (Input (Evt D))
radioGroup' [Gui] -> Gui
ver

radioGroup'  :: ([Gui] -> Gui) -> Evt D -> [String] -> Int -> Source (Evt D)
radioGroup' :: ([Gui] -> Gui)
-> Input (Evt D) -> [String] -> Int -> Source (Input (Evt D))
radioGroup' [Gui] -> Gui
gcat Input (Evt D)
ctrl [String]
names Int
initVal =  (Sig -> Input (Evt D)) -> Source Sig -> Source (Input (Evt D))
forall a b. (a -> b) -> Source a -> Source b
mapSource Sig -> Input (Evt D)
snaps (Source Sig -> Source (Input (Evt D)))
-> Source Sig -> Source (Input (Evt D))
forall a b. (a -> b) -> a -> b
$ ([Gui] -> Gui) -> Sig -> [String] -> Int -> Source Sig
radioGroupSig' [Gui] -> Gui
gcat (D -> Input (Evt D) -> Sig
evtToSig (Int -> D
int Int
initVal) Input (Evt D)
ctrl) [String]
names Int
initVal

radioGroupSig'  :: ([Gui] -> Gui) -> Sig -> [String] -> Int -> Source Sig
radioGroupSig' :: ([Gui] -> Gui) -> Sig -> [String] -> Int -> Source Sig
radioGroupSig' [Gui] -> Gui
gcat Sig
ctrl [String]
names Int
initVal = Source Sig -> Source Sig
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source Sig -> Source Sig) -> Source Sig -> Source Sig
forall a b. (a -> b) -> a -> b
$ do
    ([Gui]
guis, [Sig -> SE ()]
writes, [Sig]
reads) <- ([(Gui, Sig -> SE (), Sig)] -> ([Gui], [Sig -> SE ()], [Sig]))
-> SE [(Gui, Sig -> SE (), Sig)]
-> SE ([Gui], [Sig -> SE ()], [Sig])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Gui, Sig -> SE (), Sig)] -> ([Gui], [Sig -> SE ()], [Sig])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 (SE [(Gui, Sig -> SE (), Sig)]
 -> SE ([Gui], [Sig -> SE ()], [Sig]))
-> SE [(Gui, Sig -> SE (), Sig)]
-> SE ([Gui], [Sig -> SE ()], [Sig])
forall a b. (a -> b) -> a -> b
$ ((Int, String) -> SE (Gui, Sig -> SE (), Sig))
-> [(Int, String)] -> SE [(Gui, Sig -> SE (), Sig)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Int
i, String
tag) -> (String -> Bool -> SE (Gui, Sig -> SE (), Sig))
-> Bool -> String -> SE (Gui, Sig -> SE (), Sig)
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Bool -> SE (Gui, Sig -> SE (), Sig)
setToggleSig (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
initVal) String
tag) ([(Int, String)] -> SE [(Gui, Sig -> SE (), Sig)])
-> [(Int, String)] -> SE [(Gui, Sig -> SE (), Sig)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [String]
names
    Ref Sig
curRef <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newGlobalCtrlRef (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ Int -> D
int Int
initVal)

    BoolSig -> SE () -> SE ()
when1 ([Sig] -> Sig
changed [Sig
ctrl] Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
curRef Sig
ctrl

    Sig
current <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
curRef
    ((Sig -> SE ()) -> Sig -> SE ())
-> [Sig -> SE ()] -> [Sig] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Sig -> SE ()
w Sig
i -> Sig -> SE ()
w (Sig -> SE ()) -> Sig -> SE ()
forall a b. (a -> b) -> a -> b
$ BoolSig -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (Sig
current Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
i) Sig
1 Sig
0) [Sig -> SE ()]
writes [Sig]
ids
    (Sig -> Sig -> SE ()) -> [Sig] -> [Sig] -> SE ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Sig
r Sig
i -> Input (Evt D) -> Bam D -> SE ()
forall a. Evt a -> Bam a -> SE ()
runEvt (Sig -> Input (Evt D)
snaps Sig
r) (Bam D -> SE ()) -> Bam D -> SE ()
forall a b. (a -> b) -> a -> b
$ \D
x -> do
        BoolSig -> SE () -> SE ()
when1 (D -> Sig
sig D
x Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
            Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
curRef Sig
i
        BoolSig -> SE () -> SE ()
when1 (D -> Sig
sig D
x Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
0 BoolSig -> BoolSig -> BoolSig
forall b. Boolean b => b -> b -> b
&&* Sig
current Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
i) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ do
           Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
curRef Sig
i
        ) [Sig]
reads [Sig]
ids

    Sig
res <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
curRef
    (Gui, Sig) -> Source Sig
forall (m :: * -> *) a. Monad m => a -> m a
return ([Gui] -> Gui
gcat [Gui]
guis, Sig
res)
    where
        ids :: [Sig]
ids = (Int -> Sig) -> [Int] -> [Sig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D -> Sig
sig (D -> Sig) -> (Int -> D) -> Int -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> D
int) [Int
0 .. [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
names Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]


ctrlSig :: D -> Sig -> SinkSource Sig -> Source Sig
ctrlSig :: D -> Sig -> SE (Gui, Sig -> SE (), Sig) -> Source Sig
ctrlSig D
initVal Sig
ctrl SE (Gui, Sig -> SE (), Sig)
v = Source Sig -> Source Sig
forall a. SE (Gui, Input a) -> SE (Gui, Input a)
source (Source Sig -> Source Sig) -> Source Sig -> Source Sig
forall a b. (a -> b) -> a -> b
$ do
    (Gui
gui, Sig -> SE ()
output, Sig
input) <- SE (Gui, Sig -> SE (), Sig)
v
    Ref Sig
ref <- Sig -> SE (Ref Sig)
forall a. Tuple a => a -> SE (Ref a)
newGlobalCtrlRef (D -> Sig
sig D
initVal)
    BoolSig -> SE () -> SE ()
when1 ([Sig] -> Sig
changed [Sig
ctrl] Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
ref Sig
ctrl
    BoolSig -> SE () -> SE ()
when1 ([Sig] -> Sig
changed [Sig
input] Sig -> Sig -> BoolSig
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Sig
1) (SE () -> SE ()) -> SE () -> SE ()
forall a b. (a -> b) -> a -> b
$ Ref Sig -> Sig -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref Sig
ref Sig
input
    Sig
res <- Ref Sig -> SE Sig
forall a. Tuple a => Ref a -> SE a
readRef Ref Sig
ref
    Sig -> SE ()
output Sig
res
    (Gui, Sig) -> Source Sig
forall (m :: * -> *) a. Monad m => a -> m a
return (Gui
gui, Sig
res)