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 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)
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
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
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
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
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
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
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
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
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
uslider :: Double -> Source Sig
uslider :: Double -> Source Sig
uslider = String -> ValSpan -> Double -> Source Sig
slider String
"" (Double -> Double -> ValSpan
linSpan Double
0 Double
1)
uknob :: Double -> Source Sig
uknob :: Double -> Source Sig
uknob = String -> ValSpan -> Double -> Source Sig
knob String
"" (Double -> Double -> ValSpan
linSpan Double
0 Double
1)
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
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
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)
hnumbers :: [Double] -> Source Sig
hnumbers :: [Double] -> Source Sig
hnumbers = ([Gui] -> Gui) -> [Double] -> Source Sig
genNumbers [Gui] -> Gui
hor
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"
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
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
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
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
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
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
hradioSig :: [String] -> Int -> Source Sig
hradioSig :: [String] -> Int -> Source Sig
hradioSig = ([Gui] -> Gui) -> [String] -> Int -> Source Sig
radioGroupSig [Gui] -> Gui
hor
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]
type Range a = (a, a)
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
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
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
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. Semigroup a => a -> a -> a
<> )
| Bool
otherwise = Input (Evt D) -> Input (Evt D)
forall a. a -> a
id
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)
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
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
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
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
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
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
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
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
hradioSig' :: Sig -> [String] -> Int -> Source Sig
hradioSig' :: Sig -> [String] -> Int -> Source Sig
hradioSig' = ([Gui] -> Gui) -> Sig -> [String] -> Int -> Source Sig
radioGroupSig' [Gui] -> Gui
hor
vradioSig' :: Sig -> [String] -> Int -> Source Sig
vradioSig' :: Sig -> [String] -> Int -> Source Sig
vradioSig' = ([Gui] -> Gui) -> Sig -> [String] -> Int -> Source Sig
radioGroupSig' [Gui] -> Gui
ver
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
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)