%-*- mode: Latex; abbrev-mode: true; auto-fill-function: do-auto-fill -*- %include lhs2TeX.fmt %include myFormat.fmt \out{ \begin{code} -- This code was automatically generated by lhs2tex --code, from the file -- HSoM/MUI.lhs. (See HSoM/MakeCode.bat.) \end{code} } \chapter{Musical User Interface} \chapterauthor{Daniel Winograd-Cort} \label{ch:MUI} \noindent\begin{code} {-# LANGUAGE Arrows #-} module Euterpea.Examples.MUI where import Euterpea \end{code} \out{\begin{code} import Data.Maybe (mapMaybe) import Euterpea.Experimental import FRP.UISF.Graphics (withColor', rgbE, rectangleFilled) import FRP.UISF.Widget.Construction (mkWidget) \end{code}} This module is not part of the standard Euterpea module hierarchy (i.e.\ those modules that get imported by the header command ``|import Euterpea|''), but it can be found in the |Examples| folder in the Euterpea distribution, and can be imported into another module by the header command: \begin{spec} import Euterpea.Examples.MUI \end{spec} \syn{To use the \emph{arrow syntax} described in this chapter, it is necessary to use the following compiler pragma in GHC: \begin{spec} {-# LANGUAGE Arrows #-} \end{spec} } %% In addition, the ``TupleSections'' pragma permits the use of tuple %% sections---for example, |(,42)| is the same as the function %% |\x->(x,42)|. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Introduction %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Introduction} Many music software packages have a graphical user interface (aka ``GUI'') that provides varying degrees of functionality to the user. In Euterpea a basic set of widgets is provided that are collectively referred to as the \emph{musical user interface}, or MUI. This interface is quite different from the GUI interfaces found in most conventional languages, and is built around the concepts of \emph{signal functions} and \emph{arrows} \cite{AFP2002,Hughes2000}.\footnote{The Euterpea MUI is built using the arrow-based GUI library \emph{UISF}, which is its own standalone package. UISF, in turn, borrows concepts from \emph{Fruit} \cite{fruit,courtney-phd}.} Signal functions are an abstraction of the time-varying values inherent in an interactive system such as a GUI or Euterpea's MUI. Signal functions are provided for creating graphical sliders, pushbuttons, and so on for input; textual displays, graphs, and graphic images for output; and textboxes, virtual keyboards, and more for combinations of input and output. In addition to these graphical widgets, the MUI also provides an interface to standard MIDI input and output devices. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Introduction - Basic Concepts %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Basic Concepts} A \emph{signal} is a time-varying quantity. Conceptually, at least, most things in our world, and many things that we program with, are time-varying. The position of a mouse is time-varying. So is the voltage used to control a motor in a robot arm. Even an animation can be thought of as a time-varying image. A \emph{signal function} is an abstract function that converts one signal into another. Using the examples above, a signal function may add an offset to a time-varying mouse position, filter out noise from the time-varying voltage for a robot motor, or speed up or slow down an animation. Perhaps the simplest way to understand Euterpea's approach to programming with signals is to think of it as a language for expressing \emph{signal processing diagrams} (or equivalently, electrical circuits). We can think of the lines in a typical signal processing diagram as signals, and the boxes that convert one signal into another as signal functions. For example, this very simple diagram has two signals, |x| and |y|, and one signal function, |sigfun|: \begin{center} \includegraphics[scale=0.80]{pics/frp-circuit} \end{center} Using Haskell's \emph{arrow syntax} \cite{Hughes2000,Paterson2001}, this diagram can be expressed as a code fragment in Euterpea simply as: \begin{spec} y <- sigfun -< x \end{spec} \syn{The syntax |<-| and |-<| is typeset here in an attractive way, but the user will have to type \verb+<-+ and \verb+-<+, respectively, in her source file.} In summary, the arrow syntax provides a convenient way to compose signal functions together---i.e.\ to wire together the boxes that make up a signal processing diagram. %% \section{Signals} %% \label{sec:signals} %% A value of type |Signal T| is a time-varying value of type |T|. For %% example, |Signal Float| is a time-varying floating-point number, %% |Signal AbsPitch| is a time-varing absolute pitch, and so on. %% Abstractly, we can think of a signal as a function: %% \begin{spec} %% Signal a = Time -> a %% \end{spec} %% where |Time| is some suitable representation of time. %% %% (currently |Double| in Euterpea). %% However, this is not how signals are actually implemented in Euterpea, %% indeed the above is not even valid Haskell syntax. Nevertheless it is %% helpful to think of signals in this way. Indeed, for pedagogical %% purposes, we can go one step further and write the above as a Haskell %% data declaration: %% \begin{spec} %% data Signal a = Sig (Time -> a) %% \end{spec} %% and then describe in more detail how signals are manipulated once this %% concrete representation is in hand. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Introduction - The Type of a Signal Function %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{The Type of a Signal Function} \label{sec:sigfun-type} Polymorphically speaking, a signal function has type |SF a b|, which should be read, ``the type of signal functions that convert signals of type |a| into signals of type |b|.'' %% Keep in mind that a signal function is an \emph{abstract function}, %% meaning that its actual representation in Eutperpea is hidden. And %% there are no values that directly represent \emph{signals} in %% Euterpea---there are only signal \emph{functions}. So you cannot %% simply apply a signal function to an argument like an ordinary %% function. That, in fact, is the purpose of the arrow syntax. For example, suppose the signal function |sigfun| used earlier has type |SF T1 T2|, for some types |T1| and |T2|. In that case, and using the example above, |x| will have type |T1|, and |y| will have type |T2|. Although signal functions act on signals, the arrow notation allows us to manipulate the instantaneous values of the signals, such as |x| and |y| above, directly. A signal function whose type is of the form |SF () b| essentially takes no input, but produces some output of type |b|. Because of this we often refer to such a signal function as a \emph{signal source}. Similarly, a signal function of type |SF a ()| is called a \emph{signal sink}---it takes input, but produces no output. Signal sinks are essentially a form of output to the real world. We can also create and use signal functions that operate on signals of tuples. For example, a signal function |exp :: SF (Double, Double) Double| that raises the first argument in a tuple to the power of its second, at every point in time, could be used as follows: \begin{spec} z <- exp -< (x,y) \end{spec} As mentioned earlier, a signal function is ``abstract,'' in the sense that it cannot be applied like an ordinary function. Indeed, |SF| is an instance of the |Arrow| type class in Haskell, which only provides operations to \emph{compose} one signal function with another in several ways. The |Arrow| class and how all this works for signal functions will be described in Chapter~\ref{ch:arrows}. For now, it suffices to say that programming in this style can be awkward and that Haskell provides the arrow syntax described above to make the programming easier and more natural. A Euterpea MUI program expresses the composition of a possibly large number of signal functions into a composite signal function that is then ``run'' at the top level by a suitable interpreter. A good analogy for this idea is a state or IO monad, where the state is hidden, and a program consists of a linear sequencing of actions that are eventually run by an interpreter or the operating system. But in fact arrows are more general than monads, and in particular the composition of signal functions does not have to be completely linear, as will be illustrated shortly. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Introduction - |proc| Declarations %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{|proc| Declarations} Arrows and arrow syntax will be described in more detail in Chapter~\ref{ch:arrows}. For now, keep in mind that |<-| and |-<| are part of the \emph{syntax}, and are not simply binary operators. Indeed, we cannot just write the earlier code fragments anywhere. They have to be within an enclosing |proc| construct whose result type is that of a signal function. The |proc| construct begins with the keyword |proc| along with a formal parameter, analogous to an anonymous function. For example, a signal function that takes a signal of type |Double| and adds 1 to it at every point in time, and then applies |sigfun| to the resulting signal, can be written: \begin{spec} proc y -> do x <- sigfun -< y+1 outA -< x \end{spec} |outA| is a special signal function that specifies the output of the signal function being defined. \syn{The |do| keyword in arrow syntax introduces layout, just as it does in monad syntax.} Note the analogy of this code to the following snippet involving an ordinary anonymous function: \begin{spec} \ y -> let x = sigfun' (y+1) in x \end{spec} The important difference, however, is that |sigfun| works on a signal, i.e.\ a time-varying quantity. To make the analogy a little stronger, we could imagine a signal being implemented as a stream of discrete values. In which case, to achieve the effect of the arrow code given d, we would have to write something like this: \begin{spec} \ ys -> let xs = sigfun'' (map (+1) ys) in xs \end{spec} The arrow syntax allows us to avoid worrying about the streams themselves. %% It also has other important advantages that are beyond the scope of %% the current discussion. %% Arrow syntax is just that---syntactic sugar that is expanded into a %% set of conventional functions that work just as well, but are more %% cumbersome to program with (just as with monad syntax). This %% syntactic expansion will be described in more detail in %% Chapter~\ref{ch:arrows}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Introduction - Four Useful Functions %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Four Useful Functions} \label{sec:useful-funs} There are four useful auxiliary functions that will make writing signal functions a bit easier. The first two essentially ``lift'' constants and functions from the Haskell level to the arrow (signal function) level: \begin{spec} arr :: (a -> b) -> SF a b constA :: b -> SF () b \end{spec} For example, a signal function that adds one to every sample of its input can be written simply as |arr (+1)|, and a signal function that returns the constant 440 as its result can be written |constA 440| (and is a signal source, as defined earlier). The other two functions allow us to \emph{compose} signal functions: \begin{spec} (>>>) :: SF a b -> SF b c -> SF a c (<<<) :: SF b c -> SF a b -> SF a c \end{spec} |(<<<)| is analogous to Haskell's standard composition operator |(.)|, whereas |(>>>)| is like ``reverse composition.'' As an example that combines both of the ideas above, recall the very first example given in this chapter: \begin{spec} proc y -> do x <- sigfun -< y+1 outA -< x \end{spec} which essentially applies |sigfun| to one plus the input. This signal function can be written more succinctly as either |arr (+1) >>> sigfun| or |sigfun <<< arr (+1)|. The functions |(>>>)|, |(<<<)|, and |arr| are actually generic operators on arrows, and thus to use them one may import them from the |Arrow| library. However, Euterpea reexports them automatically so we need not do this. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Introduction - Events %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Events} \label{sec:events} Although signals are a nice abstraction of time-varying entities, and the world is arguably full of such entities, there are some things that happen at discrete points in time, like a mouse click, or a MIDI keyboard press, and so on. We call these \emph{events}. To represent events, and have them coexist with signals, recall the |Maybe| type defined in the Standard Prelude: \begin{spec} data Maybe a = Nothing | Just a \end{spec} Conceptually, we define an event simply as a value of type |Maybe a|, for some type |a|. We say that the value associated with an event is ``attached to'' or ``carried by'' that event. However, to fit this into the signal function paradigm, we imagine \emph{signals of events}---in other words, \emph{event streams}. So a signal function that takes events of type |Maybe T1| as input, and emits events of type |Maybe T2|, would have type |SF (Maybe T1) (Maybe T2)|. When there is no event, an event stream will have the instantaneous value |Nothing|, and when an event occurs, it will have the value |Just x| for some value x. For convenience Euterpea defines a type synonym for events: \begin{spec} type SEvent a = Maybe a \end{spec} The name |SEvent| is used to distinguish it from performance |Event| as defined in Chapter~\ref{ch:performance}. ``|SEvent|'' can be read as ``signal event.'' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Introduction - Feedback %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Feedback} If we think about signal functions and arrows as signal processing diagrams, then so far, we have only considered how to connect them so that the streams all flow in the same direction. However, there may be times that we want to feed an output of one signal function back in as one of its inputs, thus creating a loop. %% TODO: This might be a good place to have a diagram of a loop How can a signal function depend on its own output? At some point in the loop, we need to introduce a \emph{delay} function. Euterpea has a few different delay functions that we will decribe in more detail later in this chapter (Section~\ref{ch:mui:sec:delays}), but for now, we will casually introduce the simplest of these: |fcdelay|. \begin{spec} fcdelay :: b -> DeltaT -> SF b b \end{spec} The name |fcdelay| stands for ``fixed continuous delay'', and it delays a continuous signal for a fixed amount of time. (Note that |DeltaT| is a type synonym for |Double| and represents a change in time, or $\delta t$.) Thus, the signal function |fcdelay b t| will delay its input signal for |t| seconds, emitting the constant signal |b| for the first |t| seconds. With a delay at the ready, we can create a loop in a signal function by using the |rec| keyword in the arrow syntax. This keyword behaves much like it does in monadic |do| syntax and allows us to use a signal before we have defined it. For instance, we can create a signal function that will count how many seconds have gone by since it started running: \begin{spec} secondCounter :: SF () Integer secondCounter = proc () -> do rec count <- fcdelay 0 1 -< count + 1 outA -< count \end{spec} \syn{The |rec| keyword comes from an extension to arrows called \emph{arrow loop}. To use the same ability outside of the arrow syntax requires the |loop| operator: \begin{spec} loop :: SF (b, d) (c, d) -> SF b c \end{spec}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Introduction - [Advanced] Why Arrows? %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{[Advanced] Why Arrows?} It is possible, and fairly natural, to define signal functions directly, say as an abstract type |Signal T|, and then define functions to add, multiply, take the sine of, and so on, signals represented in this way. For example, |Signal Float| would be the type of a time-varying floating-point number, |Signal AbsPitch| would be the type of a time-varying absolute pitch, and so on. Then given |s1,s2 :: Signal Float| we might simply write |s1 + s2|, |s1 * s2|, and |sin s1| as examples of applying the above operations. Haskell's numeric type class hierarchy makes this particularly easy to do. Indeed, several domain-specific languages based on this approach have been designed, beginning with the language \emph{Fran} \cite{Fran} that was designed for writing computer animation programs. But years of experience and theoretical study have revealed that such an approach leads to a language with subtle time- and space-leaks,\footnote{A time-leak in a real-time system occurs whenever a time-dependent computation falls behind the current time because its value or effect is not needed yet, but then requires ``catching up'' at a later point in time. This catching up process can take an arbitrarily long time, and may consume additional space as well. It can destroy any hope for real-time behavior if not managed properly.} for reasons that are beyond the scope of this textbook \cite{Leak07}. Perhaps surprisingly, these problems can be avoided by using arrows. Programming in this style gives the user access to signal functions, and the individual values that comprise a signal, but not to the actual signal itself. By not giving the user direct access to signals, and providing a disciplined way to compose signal functions (namely arrow syntax), time- and space-leaks are avoided. In fact, the resulting framework is highly amenable to optimization, although this requires using special features in Haskell, as described in Chapter \ref{ch:arrows}. %% Although we like to think of signals as continuous, time-varying %% quantities, in practice we know that they are sampled representations %% of continous quantities, as discussed earlier. It is often important, %% in a given context, to know what that sampling rate is. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% The UISF Arrow %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{The UISF Arrow} \label{sec:UI} |SF| as used in this chapter so far is an instance of the |Arrow| class, but is not the actual type used for constructing MUIs. The core component of Euterpea's MUI is the \emph{user interface signal function}, captured by the type |UISF|, which is also an instance of the |Arrow| class. So instead of |SF|, in the remainder of this chapter we will use |UISF|, but all of the previous discussion about signal functions and arrows still applies. Using |UISF|, we can create ``graphical widgets'' using a style very similar to the way we wired signal functions earlier. However, instead of having values of type |SF a b|, we will use values of type |UISF a b|. Just like |SF|, the |UISF| type is fully abstract (meaning its implementation is hidden) and, being an instance of the |Arrow| class, can be used with arrow syntax. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% The UISF Arrow - Graphical Input and Output Widgets %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Graphical Input and Output Widgets} Euterpea's basic widgets are shown in Figure \ref{fig:widgets}. Note that each of them is, ultimately, a value of type |UISF a b|, for some input type |a| and output type |b|, and therefore may be used with the arrow syntax to help coordinate their functionality. The names and type signatures of these functions suggest their functionality, which we elaborate in more detail below: \begin{figure} \cbox{ \begin{spec} label :: String -> UISF a a displayStr :: UISF String () display :: Show a => UISF a () withDisplay :: Show b => UISF a b -> UISF a b textbox :: UISF String String textboxE :: String -> UISF (SEvent String) String radio :: [String] -> Int -> UISF () Int button :: String -> UISF () Bool checkbox :: String -> Bool -> UISF () Bool checkGroup :: [(String, a)] -> UISF () [a] listbox :: (Eq a, Show a) => UISF ([a], Int) Int hSlider, vSlider :: RealFrac a => (a, a) -> a -> UISF () a hiSlider, viSlider :: Integral a => a -> (a, a) -> a -> UISF () a \end{spec}} \caption{Basic MUI Input/Output Widgets} \label{fig:widgets} \end{figure} \begin{itemize} \item A simple (static) text string can be displayed using: \begin{spec} label :: String -> UISF a a \end{spec} \item Alternatively, a time-varying string can be be displayed using: \begin{spec} displayStr :: UISF String () \end{spec} For convenience, Euterpea defines the following useful variations of |displayStr|: \begin{spec} display :: Show a => UISF a () display = arr show >>> displayStr withDisplay :: Show b => UISF a b -> UISF a b withDisplay sf = proc a -> do b <- sf -< a display -< b outA -< b \end{spec} |display| allows us to display anything that is ``|Show|able.'' |withDisplay| is an example of a \emph{signal function transformer}: it takes a signal function and attaches a display widget to it that displays the value of its time-varying output. \item A textbox that functions for both input and output can be created using: \begin{spec} textbox :: UISF String String \end{spec} A |textbox| in Euterpea is notable because it is ``bidirectional.'' That is, the time-varying input is displayed, and the user can interact with it by typing or deleting, the result being the time-varying output. In practice, the textbox is used almost exclusively with the |rec| keyword and a |delay| operator. For example, a code snippet from a MUI that uses |textbox| may look like this: \begin{spec} rec str <- textbox <<< delay "Initial text" -< str \end{spec} Because of this common usage, there is a variant of the textbox: \begin{spec} textboxE :: String -> UISF (SEvent String) String \end{spec} A |textboxE| widget encapsulates the recursion and delay internally. Thus, its initial value is given by its static argument, and its input stream is an event stream that will update the displayed text when there is an event and leave it unchanged otherwise. \item |radio|, |button|, and |checkbox| are three kinds of ``pushbuttons.'' A |button| (or |checkbox|) is pressed and unpressed (or checked and \newline unchecked) independently of others. In contrast, a |radio| button is dependent upon other radio buttons---specifically, only one can be ``on'' at a time, so pressing one will turn off the others. The string argument to these functions is the label attached to the button. |radio| takes a list of strings, each being the label of one of the buttons in the mutually-exclusive group; indeed the length of the list determines how many buttons are in the group. The |checkGroup| widget creates a group of |checkbox|es. As its static argument, it takes a list of pairs of strings and values. For each pair, one |checkbox| is created with the associated string as its label. Rather than simply returning |True| or |False| for each checked box, it returns a list of the values associated with each label as its output stream. \item The |listbox| widget creates a pane with selectable text entries. The input stream is the list of entries as well as which entry is currently selected, and the output stream is the index of the newly selected entry. In many ways, this widget functions much like the |radio| widget except that it is stylistically different, it is dynamic, and, like the |textbox| widget, it is bidirectional. \item |hSlider|, |vSlider|, |hiSlider| and |viSlider| are four kinds of ``sliders''---a graphical widget that looks like a slider control as found on a hardware device. The first two yield floating-point numbers in a given range, and are oriented horizontally and vertically, respectively, whereas the latter two return integral numbers. For the integral sliders, the first argument is the size of the step taken when the slider is clicked at any point on either side of the slider ``handle.'' In each of the four cases, the other two arguments are the range and initial setting of the slider, respectively. \end{itemize} As a simple example, here is a MUI that has a single slider representing absolute pitch, and a display widget that displays the pitch corresponding to the current setting of the slider: \begin{code} ui0 :: UISF () () ui0 = proc _ -> do ap <- hiSlider 1 (0,100) 0 -< () display -< pitch ap \end{code} Note how the use of signal functions makes this dynamic MUI trivial to write. But using the functions defines in Section~\ref{sec:useful-funs} it can be defined even more succinctly as: \begin{spec} ui0 = hiSlider 1 (0,100) 0 >>> arr pitch >>> display \end{spec} We can execute this example using the function: \begin{spec} runMUI' :: UI () () -> IO () \end{spec} So our first running example of a MUI is: \begin{code} mui0 = runMUI' ui0 \end{code} The resulting MUI, once the slider has been moved a bit, is shown in Figure \ref{fig:simple-mui}(a). \syn{ Any MUI widgets have the capacity to be \emph{focusable}, which is particularly relevant for graphical widgets. When a focusable widget is ``in focus,'' not only can it update its appearance, but any key presses from the computer keyboard become visible to it as input events. This means that keyboard controls are possible with MUI widgets. Obviously, typing will affect the value of a textbox widget, but also, for instance, the arrow keys as well as the ``Home'' and ``End'' keys will affect the value of a slider widget. Focus can be shifted between widgets by clicking on them with the mouse as well as by using ``Tab'' and ``Shift+Tab'' to cycle focus through focusable widgets.} \begin{figure}[hbtp] \centering \subfigure[Very Simple]{ \includegraphics[height=2.3in]{pics/mui0.eps} } \subfigure[With Titles and Sizing]{ \includegraphics[height=2.3in]{pics/mui1.eps} } \subfigure[With Alternate (left-to-right) Layout]{ \includegraphics[height=2.3in]{pics/mui2.eps} } \caption{Several Simple MUIs} \label{fig:simple-mui} \end{figure} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% The UISF Arrow - Widget Transformers %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Widget Transformers} \label{ch:mui:sec:wt} Figure \ref{fig:layout-widgets} shows a set of ``widget transformers''---functions that take UISF values as input, and return modified UISF values as output. \begin{figure} \cbox{ \begin{spec} title :: String -> UISF a b -> UISF a b setLayout :: Layout -> UISF a b -> UISF a b setSize :: (Int, Int) -> UISF a b -> UISF a b pad :: (Int, Int, Int, Int) -> UISF a b -> UISF a b topDown, bottomUp, leftRight, rightLeft :: UISF a b -> UISF a b makeLayout :: LayoutType -> LayoutType -> Layout data LayoutType = Stretchy { minSize :: Int } | Fixed { fixedSize :: Int } \end{spec}} \caption{MUI Layout Widget Transformers} \label{fig:layout-widgets} \end{figure} \begin{itemize} \item |title| simply attaches a title (a string) to a UISF, and |setLayout| establishes a new layout for a UISF. The general way to make a new layout is to use |makeLayout|, which takes layout information for first the horizontal dimension and then the vertical. A dimension can be either stretchy (with a minimum size in pixels but that will expand to fill the space it is given) or fixed (measured in pixels). The |setSize| function is a convenient function for setting the layout of a widget when both dimensions need to be fixed. It is defined as: \begin{spec} setSize (w,h) = setLayout (makeLayout (Fixed w) (Fixed h)) \end{spec} For example we can modify the previous example to both set a fixed layout for the overall widget, and attach titles to both the slider and display: \begin{code} ui1 :: UISF () () ui1 = setSize (150,150) $ proc _ -> do ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< () title "Pitch" display -< pitch ap mui1 = runMUI' ui1 \end{code} %% $ This MUI is shown in Figure \ref{fig:simple-mui}(b). \item |pad (w,n,e,s) ui| adds |w| pixels of space to the ``west'' of the UISF |ui|, and |n|, |e|, and |s| pixels of space to the north, east, and south, respectively. \item The remaining four functions are used to control the relative layout of the widgets within a UISF. By default widgets are arranged top-to-bottom, but, for example, we could modify the previous UISF program to arrange the two widgets left-to-right: \begin{code} ui2 :: UISF () () ui2 = leftRight $ proc _ -> do ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< () title "Pitch" display -< pitch ap mui2 = runMUI' ui2 \end{code} This MUI is shown in Figure \ref{fig:simple-mui}(c). \end{itemize} Widget transformers can be nested (as demonstrated in some later examples), so a fair amount of flexibility is available. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% The UISF Arrow - MIDI Input and Output %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{MIDI Input and Output} \label{ch:mui:sec:midiinout} % TODO: This (and the deviceID) section may need to be rewritten % FIXME: Even if it stays basically the same, the following code uses % the "unique" mediator, which hasn't been introduced yet. An important application of events in Euterpea is real-time, interactive MIDI. There are two main UISF signal functions that handle MIDI, one for input and the other for output, but neither of them displays anything graphically: \begin{spec} midiIn :: UISF ( Maybe InputDeviceID) ( SEvent [MidiMessage]) midiOut :: UISF ( Maybe OutputDeviceID, SEvent [MidiMessage]) () \end{spec} Except for the input and output deviceIDs (about which more will be said shortly), these signal functions are fairly straightforward: |midiOut| takes a stream of |MidiMessage| events and sends them to the MIDI output device (thus a signal sink), whereas |midiIn| generates a stream of |MidiMessage| events corresponding to the messages sent by the MIDI input device (thus a signal source)\footnote{Technically, this is not a proper signal source because it accepts an input stream of |Maybe InputDeviceID|, but the way in which it generates MIDI messages makes it feel very much like a source.}. In both cases, note that the events carry \emph{lists} of MIDI messages, thus accounting for the possibility of simultaneous events. The |MidiMessage| data type is defined as: \begin{spec} data MidiMessage = ANote { channel :: Channel, key :: Key, velocity :: Velocity, duration :: Time } | Std Message deriving Show \end{spec} A |MidiMessage| is either an |ANote|, which allows us to specify a note with duration, or is a standard MIDI |Message|. MIDI does not have a notion of duration, but rather has separate |NoteOn| and |NoteOff| messages. With |ANote|, the design above is a bit more convenient, although what happens ``behind the scenes'' is that each |ANote| is transformed into a |NoteOn| and |NoteOff| event. The |Message| data type is described in Chapter~\ref{ch:midi}, and is defined in the |Codec.Midi| module. Its most important functionality is summarized here: \begin{spec} data Message = -- Channel Messages NoteOff { channel :: Channel, key :: Key, velocity :: Velocity } | NoteOn { channel :: Channel, key :: Key, velocity :: Velocity } | ProgramChange { channel :: Channel, preset :: Preset } | ... -- Meta Messages | TempoChange Tempo | | ... deriving (Show,Eq) \end{spec} %% data Message = %% -- Channel Messages %% NoteOff { channel :: !Channel, key :: !Key, velocity :: !Velocity } %% | NoteOn { channel :: !Channel, key :: !Key, velocity :: !Velocity } %% | ProgramChange { channel :: !Channel, preset :: !Preset } %% | ... %% -- Meta Messages %% | TempoChange !Tempo | %% | ... %% deriving (Show,Eq) MIDI's notion of a ``key'' is the key pressed on a MIDI instrument, not to be confused with ``key'' as in ``key signature.'' Also, MIDI's notion of ``velocity'' is the rate at which the key is pressed, and is roughly equivalent to what we have been calling ``volume.'' So, for example, a MIDI message |NoteOn c k v| plays MIDI key |k| on MIDI channel |c| with velocity |v|. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% The UISF Arrow - MIDI Device IDs %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{MIDI Device IDs} \label{ch:mui:sec:mididevs} Before we can create an example using |midiIn| or |midiOut|, we first must consider their other arguments: |InputDeviceID| and |OutputDeviceID|. The MIDI device ID is a system-dependent concept that provides an operating system with a simple way to uniquely identify various MIDI devices that may be attached to a computer. Indeed, as devices are dynamically connected and disconnected from a computer, the mapping of these IDs to a particular device may change. Thus, the only way to get an input or output device ID is by selection with one of the following widgets: \begin{spec} selectInput :: UISF () (Maybe InputDeviceID) selectOutput :: UISF () (Maybe OutputDeviceID) \end{spec} Each of these widgets automatically queries the operating system to obtain a list of connected MIDI devices, and then displays the list as a set of radio buttons, allowing the user to select one of them. In the event that there are no available devices, the widget can then return |Nothing|. %% This makes wiring up the user choice very easy. With these functions, we can now create an example using MIDI output. Let's modify our previous MUI program to output an |ANote| message every time the absolute pitch changes: \begin{code} ui3 :: UISF () () ui3 = proc _ -> do devid <- selectOutput -< () ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< () title "Pitch" display -< pitch ap uap <- unique -< ap midiOut -< (devid, fmap (\k-> [ANote 0 k 100 0.1]) uap) mui3 = runMUI' ui3 \end{code} The |unique| signal function used here is an example of a \emph{mediator}, or a signal function that mediates between continuous and discrete signals. We will explore more mediators in Section~\ref{ch:mui:sec:mediators}, but in this case, note that |unique| will generate an event whenever its input, the continuous absolute pitch stream, changes. Each of those events, named |uap| above, carries the new absolute pitch, and that pitch is used directly as the MIDI key field in |ANote|. To understand how that last part is done on the |midiOut| line, recall that |fmap| is the primary method in the |Functor| class as described in Section~\ref{sec:functor-class}, and the |Maybe| type is an instance of |Functor|. Therefore, since |SEvent| is a type synonym for |Maybe|, the use of |fmap| above is valid---and all it does is apply the functional argument to the value ``attached to'' the event, which in this case is an absolute pitch. For an example using MIDI input as well, here is a simple program that copies each MIDI message verbatim from the selected input device to the selected output device: \begin{code} ui4 :: UISF () () ui4 = proc _ -> do mi <- selectInput -< () mo <- selectOutput -< () m <- midiIn -< mi midiOut -< (mo, m) mui4 = runMUI' ui4 \end{code} Since determining device IDs for both input and output is common, we define a simple signal function to do both: \begin{code} getDeviceIDs = topDown $ proc () -> do mi <- selectInput -< () mo <- selectOutput -< () outA -< (mi,mo) \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% The UISF Arrow - Putting It All Together %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Putting It All Together} \label{sec:runmui} Recall that a Haskell program must eventually be a value of type |IO ()|, and thus we need a function to turn a |UISF| value into a |IO| value---i.e.\ the UISF needs to be ``run.'' We can do this using one of the following two functions, the first of which we have already been using: \begin{spec} runMUI' :: UISF () () -> IO () runMUI :: UIParams -> UISF () () -> IO () \end{spec} Executing |runMUI' ui| or |runMUI params ui| will create a single MUI window whose behavior is governed by the argument |ui :: UISF () ()|. The additional |UIParams| argument of |runMUI| contains parameters that can affect the appearance and performance of the MUI window that is created. There is a default value of |UIParams| that is typical for regular MUI usage, and |runMUI'| is defined using it: \begin{spec} defaultMUIParams :: UIParams runMUI' = runMUI defaultMUIParams \end{spec} When using |runMUI|, it is advisable to simply modify the default value rather than building a whole new |UIParams| value. The easiest way to do this is with Haskell's \emph{record syntax}. There are many fields of data in a value of type |UIParams|, but we will focus only on the |uiTitle| and |uiSize|, which will control the value displayed in the title bar of the graphical window and the initial size of the window respectively. Thus, the title is a |String| value and the size is a |Dimension| value (where |Dimension| is a type synonym for |(Int, Int)|, which in turn represents a width and height measured in pixels). By default, the size is |(300,300)| and the title is |"MUI"|, but we can change these like so: \begin{code} mui'4 = runMUI (defaultMUIParams { uiTitle = "MIDI Input / Output UI", uiSize = (200,200)}) ui4 \end{code} This version of |mui4| (from the previous subsection) will run identically to the original except for the fact that its title will read ``MIDI Input / Output UI'' and its initial size will be smaller. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Non-Widget Signal Functions %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Non-Widget Signal Functions} All of the signal functions we have seen so far are effectful widgets. That is, they all do something graphical or audible when they are used. For regular computation, we have been using pure functions (which we can insert arbitrarily in arrow syntax or lift with |arr| otherwise). However, there are signal functions that are important and useful which have no visible effects. We will look at a few different types of these signal functions in this section. \syn{Note that the mediators and folds in the next two subsections are generic signal functions, and are not restricted to use only in MUIs. To highlight this, we present them with the |SF| type rather than the |UISF| type. However, they can be (and often are) used as |UISF|s in MUIs. The timers and delay functions in Subsections~\ref{ch:mui:sec:timers} and \ref{ch:mui:sec:delays} require the MUI's internal notion of time, and so we present those directly with the |UISF| type.} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Non-Widget Signal Functions - Mediators %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Mediators} \label{ch:mui:sec:mediators} In order to use event streams in the context of continuous signals, Euterpea defines a set of functions that mediate between the continuous and the discrete. These ``mediators,'' as well as some functions that deal exclusively with events, are shown in Figure~\ref{fig:mediators} along with their type signatures and brief descriptions. Their use will be better understood through some examples that follow in Section~\ref{ch:mui:sec:examples}. \begin{figure} %% in signal processing this is called an ``edge %% detector,'' and thus the name chosen here. \cbox{\small \begin{spec} unique :: Eq a => SF a (SEvent a) -- Generates an event whenever the input changes edge :: SF Bool (SEvent ()) -- Generates an event whenever the input changes from |False| to |True| hold :: a -> SF (SEvent a) a -- |hold x| begins as value |x|, but changes to the subsequent values -- attached to each of its input events accum :: a -> SF (SEvent (a -> a)) a -- |accum x| starts with the value |x|, but then applies the function -- attached to the first event to |x| to get the next value, and so on now :: SF () (SEvent ()) -- Creates a single event ``now'' and forever after does nothing. evMap :: SF a b -> SF (SEvent a) (SEvent b) -- Lifts a continuous signal function into one that handles events \end{spec}} \caption{Mediators Between the Continuous and the Discrete} \label{fig:mediators} \end{figure} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Non-Widget Signal Functions - Folds %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Folds} In traditional functional programming, a folding, or reducing, operation is one that joins together a set of data. The typical case would be an operation that operates over a list of data, such as a function that sums all elements of a list of numbers. There are a few different ways given in Euterpea to fold together signal functions to create new ones: \begin{spec} maybeA :: SF () c -> SF b c -> SF (Maybe b) c concatA :: [SF b c] -> SF [b] [c] runDynamic :: SF b c -> SF [b] [c] \end{spec} \begin{itemize} \item |maybeA| is a fold over the |Maybe| (or |SEvent|) data type. The signal function |maybeA n j| accepts as input a stream of |Maybe b| values; at any given moment, if those values are |Nothing|, then the signal function behaves like |n|, and if they are |Just b|, then it behaves like |j|. \item The |concatA| fold takes a list of signal functions and converts them to a single signal function whose streaming values are themselves lists. For example, perhaps we want to display a bunch of buttons to a user in a MUI window. Rather than coding them in one at a time, we can use |concatA| to fold them into one operation that will return their results altogether in a list. In essence, we are \emph{concat}enating the signal functions together. \item The |runDynamic| signal function is similar to |concatA| except that it takes a single signal function as an argument rather than a list. What, then, does it fold over? Instead of folding over the static signal function list, it folds over the |[b]| list that it accepts as its input streaming argument. \end{itemize} The |concatA| and |runDynamic| signal functions are definitely similar, but they are also subtly different. With |concatA|, there can be many different signal functions that are grouped together, but with |runDynamic|, there is only one. However, |runDynamic| may have a variable number of internally running signal functions at runtime because that number depends on a streaming argument. |concatA| is fixed once it is created. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Non-Widget Signal Functions - Timers %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Timers} \label{ch:mui:sec:timers} The Euterpea MUI has an implicit notion of elapsed time, but it can be made explicit by the following signal source: \begin{spec} getTime :: UISF () Time \end{spec} where |Time| is a type synonym for |Double|. Although the explicit time may be desired, some MUI widgets depend on the time implicitly. For example, the following signal function creates a \emph{timer}: \begin{spec} timer :: UISF DeltaT (SEvent ()) \end{spec} In practice, |timer -< i| takes a signal |i| that represents the timer interval (in seconds), and generates an event stream, where each pair of consecutive events is separated by the timer interval. Note that the timer interval is itself a signal, so the timer output can have varying frequency. %% Note also that, since |timer| does not have any graphical or audio %% representation, it is not actually of type |UISF|. Rather, it is a %% generic |ArrowInit|. However, as |UISF| is an instance of %% |ArrowInit|, we can use |timer| in our MUIs. To see how a timer might be used, let's modify our MUI working example from earlier so that, instead of playing a note every time the absolute pitch changes, we will output a note continuously, at a rate controlled by a second slider: \begin{code} ui5 :: UISF () () ui5 = proc _ -> do devid <- selectOutput -< () ap <- title "Absolute Pitch" (hiSlider 1 (0,100) 0) -< () title "Pitch" display -< pitch ap f <- title "Tempo" (hSlider (1,10) 1) -< () tick <- timer -< 1/f midiOut -< (devid, fmap (const [ANote 0 ap 100 0.1]) tick) -- Pitch Player with Timer mui5 = runMUI' ui5 \end{code} Note that the rate of |tick|s is controlled by the second slider---a larger slider value causes a smaller time between ticks, and thus a higher frequency, or tempo. In some cases, the simple unit events of the |timer| are not enough. Rather, we would like each event to be different while we progress through a predetermined sequence. To do this, we can use the |genEvents| signal function: \begin{spec} genEvents :: [b] -> UISF DeltaT (SEvent b) \end{spec} Just like |timer|, this signal function will output events at a variable frequency, but each successive event will contain the next value in the given list. When every value of the list |lst| has been emitted, |genEvents lst| will never again produce an event. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Non-Widget Signal Functions - Delays %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Delays} \label{ch:mui:sec:delays} Another way in which a widget can use time implicitly is in a \emph{delay}. Euterpea comes with five different delaying widgets, which each serve a specific role depending on whether the streams are continuous or event-based and if the delay is a fixed length or can be variable: \cbox{ \begin{spec} delay :: b -> UISF b b fcdelay :: b -> DeltaT -> UISF b b fdelay :: DeltaT -> UISF (SEvent b) (SEvent b) vdelay :: UISF (DeltaT, SEvent b) (SEvent b) vcdelay :: DeltaT -> b -> UISF (DeltaT, b) b \end{spec}} To start, we will examine the most straightforward one. The |delay| function creates what is called a ``unit delay'', which can be thought of as a delay by the shortest amount of time possible. This delay should be treated in the same way that one may treat a $\delta t$ in calculus; that is, although one can assume that a delay takes place, the amount of time delayed approaches zero. Thus, in practice, this should be used only in continuous cases and should only be used as a means to initialize arrow feedback. The rest of the delay operators delay by some amount of actual time, and we will look at each in turn. |fcdelay b t| will emit the constant value |b| for the first |t| seconds of the output stream and will from then on emit its input stream delayed by |t| seconds. The name comes from ``fixed continuous delay.'' One potential problem with |fcdelay| is that it makes no guarantees that every instantaneous value on the input stream will be seen in the output stream. This should not be a problem for continuous signals, but for an event stream, it could mean that entire events are accidentally skipped over. Therefore, there is a specialized delay for event streams: |fdelay t| guarantees that every input event will be emitted, but in order to achieve this, it is not as strict about timing---that is, some events may end up being over delayed. Due to the nature of events, we no longer need an initial value for output: for the first |t| second, there will simply be no events emitted. We can make both of the above delay widgets a little more complicated by introducing the idea of a variable delay. For instance, we can expand the capabilities of |fdelay| into |vdelay|. Now, the delay time is part of the signal, and it can change dynamically. Regardless, this event-based version will still guarantee that every input event will be emitted. ``|vdelay|'' can be read ``variable delay.'' For the variable continuous version, we must add one extra input parameter to prevent a possible space leak. Thus, the first argument to |vcdelay| is the maximum amount that the widget can delay. Due to the variable nature of |vcdelay|, some portions of the input signal may be omitted entirely from the output signal while others may even be outputted more than once. Thus, once again, it is highly advised to use |vdelay| rather than |vcdelay| when dealing with event-based signals. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Musical Examples %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Musical Examples} \label{ch:mui:sec:examples} In this section we work through three larger musical examples that use Euterpea's MUI in interesting ways. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Musical Examples - Chord Builder %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Chord Builder} This MUI will display a collection of chord types (Maj, Maj7, Maj9, min, min7, min9, and so on), one of which is selectable via a radio button. Then when a key is pressed on a MIDI keyboard, the selected chord is built and played using that key as the root. To begin, we define a ``database'' that associates chord types with their intervals starting with the root note: \begin{code} chordIntervals :: [ (String, [Int]) ] chordIntervals = [ ("Maj", [4,3,5]), ("Maj7", [4,3,4,1]), ("Maj9", [4,3,4,3]), ("Maj6", [4,3,2,3]), ("min", [3,4,5]), ("min7", [3,4,3,2]), ("min9", [3,4,3,4]), ("min7b5", [3,3,4,2]), ("mMaj7", [3,4,4,1]), ("dim", [3,3,3]), ("dim7", [3,3,3,3]), ("Dom7", [4,3,3,2]), ("Dom9", [4,3,3,4]), ("Dom7b9", [4,3,3,3]) ] \end{code} We will display the list of chords on the screen as radio buttons for the user to click on. The |toChord| function takes an input MIDI message as the root note, and the index of the selected chord, and outputs the notes of the selected chord. \begin{code} toChord :: Int -> MidiMessage -> [MidiMessage] toChord i m = case m of Std (NoteOn c k v) -> f NoteOn c k v Std (NoteOff c k v) -> f NoteOff c k v _ -> [] where f g c k v = map (\k' -> Std (g c k' v)) (scanl (+) k (snd (chordIntervals !! i))) \end{code} \syn{|scanl :: (a->b->a) -> a -> [b] -> [a]| is a standard Haskell function that is like |foldl :: (a->b->a) -> a -> [b] -> a|, except that every intermediate result is returned, collected together in a list.} The overall MUI is laid out in the following way: On the left side, the list of input and output devices are displayed top-down. On the right is the list of chord types. We take the name of each chord type from the |chordIntervals| list to create the radio buttons. When a MIDI input event occurs, the input message and the currently selected index to the list of chords is sent to the |toChord| function, and the resulting chord is then sent to the Midi output device. \begin{code} buildChord :: UISF () () buildChord = leftRight $ proc _ -> do (mi, mo) <- getDeviceIDs -< () m <- midiIn -< mi i <- topDown $ title "Chord Type" $ radio (fst (unzip chordIntervals)) 0 -< () midiOut -< (mo, fmap (concatMap $ toChord i) m) chordBuilder = runMUI (defaultMUIParams { uiTitle = "Chord Builder", uiSize = (600,400)}) buildChord \end{code} \syn{|unzip :: [(a,b)] -> ([a],[b])| is a standard Haskell function that does the opposite of |zip :: [a] -> [b] -> [(a,b)]|. |concatMap :: (a -> [b]) -> [a] -> [b]| is another standard Haskell function that acts as a combination of |map| and |concat|. It maps the given function over the given list and then concatenates all of the outputs into a single output list.} Figure \ref{fig:chordbuilder} shows this MUI in action. \begin{figure}[hbtp] \centering \includegraphics[height=2.3in]{pics/chordBuilder.eps} \caption{A Chord Builder MUI} \label{fig:chordbuilder} \end{figure} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Musical Examples - Chaotic Composition %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Chaotic Composition} \label{ch:mui:sec:chatoiccomp} In this section we describe a UISF that borrows some ideas from Gary Lee Nelson's composition ``Bifurcate Me, Baby!'' \cite{nelson-bifurcate}. The basic idea is to evaluate a formula called the \emph{logistic growth function}, from a branch of mathematics called chaos theory, at different points and convert the values to musical notes. The growth function is given by the recurrence equation: \[ x_{n+1} = r x_n (1 - x_n) \] Mathematically, we start with an initial population $x_0$ and iteratively apply the growth function to it, where $r$ is the growth rate. For certain values of $r$, the population stabilizes to a certain value, but as $r$ increases, the period doubles, quadruples, and eventually leads to chaos. It is one of the classic examples of chaotic behavior. We can capture the growth rate equation above in Haskell by defining a function that, given a rate |r| and current population |x|, generates the next population: \begin{code} grow :: Double -> Double -> Double grow r x = r * x * (1-x) \end{code} To generate a time-varying population, the |accum| signal function comes in handy. |accum| is one of the mediators mentioned in Section~\ref{ch:mui:sec:mediators}: it takes an initial value and an event signal carrying a modifying function, and it updates the current value by applying the function to it. \begin{spec} ... r <- title "Growth rate" $ withDisplay (hSlider (2.4, 4.0) 2.4) -< () pop <- accum 0.1 -< fmap (const (grow r)) tick ... \end{spec} %% $ The |tick| above is the ``clock tick'' that drives the simulation. We wish to define a signal |tick| that pulsates at a given frequency specified by a slider. \begin{spec} ... f <- title "Frequency" $ withDisplay (hSlider (1, 10) 1) -< () tick <- timer -< 1/f ... \end{spec} %% $ We also need a simple function that maps a population value to a musical note. As usual, this can be done in a variety of ways---here is one way: \begin{code} popToNote :: Double -> [MidiMessage] popToNote x = [ANote 0 n 64 0.05] where n = truncate (x * 127) \end{code} Finally, to play the note at every tick, we simply apply |popToNote| to every value in the time-varying population |pop|. |fmap| makes this straightforward. Putting it all together, we arrive at: \begin{code} bifurcateUI :: UISF () () bifurcateUI = proc _ -> do mo <- selectOutput -< () f <- title "Frequency" $ withDisplay (hSlider (1, 10) 1) -< () tick <- timer -< 1/f r <- title "Growth rate" $ withDisplay (hSlider (2.4, 4.0) 2.4) -< () pop <- accum 0.1 -< fmap (const (grow r)) tick _ <- title "Population" $ display -< pop midiOut -< (mo, fmap (const (popToNote pop)) tick) bifurcate = runMUI (defaultMUIParams { uiTitle = "Bifurcate!", uiSize = (300,500)}) bifurcateUI \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Musical Examples - MIDI Echo Effect %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{MIDI Echo Effect} As a final example we present a program that receives a MIDI event stream and, in addition to playing each note received from the input device, it also echoes the note at a given rate, while playing each successive note more softly until the velocity reduces to 0. The key component we need for this problem is a delay function that can delay a given event signal for a certain amount of time. Recall that the function |vdelay| takes a time signal, the amount of time to delay, and an input signal, and returns a delayed version of the input signal. There are two signals we want to attenuate, or ``decay.'' One is the signal coming from the input device, and the other is the delayed and decayed signal containing the echoes. In the code shown below, they are denoted as |m| and |s|, respectively. First we merge the two event streams into one, and then remove events with empty MIDI messages by replacing them with Nothing. The resulting signal |m'| is then processed further as follows. The MIDI messages and the current decay rate are processed with |decay|, which softens each note in the list of messages. Specifically, |decay| works by reducing the velocity of each note by the given rate and removing the note if the velocity drops to 0. The resulting signal is then delayed by the amount of time determined by another slider |f|, producing signal |s|. Signal |s| is then merged with |m| in order to define |m'| (note that |~++| is a Euterpea function that merges event lists), thus closing the loop of the recursive signal. Finally, |m'| is sent to the output device. \begin{code} echoUI :: UISF () () echoUI = proc _ -> do (mi, mo) <- getDeviceIDs -< () m <- midiIn -< mi r <- title "Decay rate" $ withDisplay (hSlider (0, 0.9) 0.5) -< () f <- title "Echoing frequency" $ withDisplay (hSlider (1, 10) 10) -< () rec s <- vdelay -< (1/f, fmap (mapMaybe (decay 0.1 r)) m') let m' = m ~++ s midiOut -< (mo, m') echo = runMUI' echoUI \end{code} \begin{code} decay :: Time -> Double -> MidiMessage -> Maybe MidiMessage decay dur r m = let f c k v d = if v > 0 then let v' = truncate (fromIntegral v * r) in Just (ANote c k v' d) else Nothing in case m of ANote c k v d -> f c k v d Std (NoteOn c k v) -> f c k v dur _ -> Nothing \end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Special Purpose and Custom Widgets %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Special Purpose and Custom Widgets} Although the widgets and signal functions described so far enable the creation of many basic MUIs, there are times when something more specific is required. Thus, in this section, we will look at some special purpose widgets as well as some functions that aid in the creation of custom widgets. Some of the functions described in this subsection are included in Euterpea by default, but others require extra imports of specific Euterpea modules. We will note this where applicable. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Custom Widgets - Realtime graphs, histograms %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Realtime graphs, histograms} So far, the only way to display the value of a stream in the MUI is to use the |display| widget. Although this is often enough, there may be times when another view is more enlightening. For instance, if the stream represents a sound wave, then rather than displaying the instantaneous values of the wave as numbers, we may wish to see them graphed. Euterpea provides support for a few different widgets that will graph streaming data visually. \begin{spec} realtimeGraph :: RealFrac a => Layout -> Time -> Color -> UISF [(a,Time)] () histogram :: RealFrac a => Layout -> UISF (SEvent [a]) () histogramWithScale :: RealFrac a => Layout -> UISF (SEvent [(a,String)]) () \end{spec} Note that each of these three functions requires a |Layout| argument (recall the |Layout| data type from Section~\ref{ch:mui:sec:wt}); this is because the layout of a graph is not as easily inferred as that for, say, a button. We will walk through the descriptions of each of these widgets: \begin{itemize} \item |realtimeGraph l t c| will produce a graph widget with layout |l|. This graph will accept as input a stream of events of pairs of values and time\footnote{These events are represented as a list rather than using the |SEvent| type because there may be more than one event at the same time. The absence of any events would be indicated by an empty list.}. The values are plotted vertically in color |c|, and the horizontal axis represents time, where the width of the graph represents an amount of time |t|. \item The histogram widgets' input are events that each contain a complete set of data. The data are plotted as a histogram within the given layout. For the histogram with the scale, each value must be paired with a |String| representing its label, and the labels are printed under the plot. \end{itemize} These widgets will prove useful when we are dealing with sound signals directly in future chapters. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Custom Widgets - More MIDI Widgets %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{More MIDI Widgets} In Sections~\ref{ch:mui:sec:midiinout} and \ref{ch:mui:sec:mididevs}, we presented simple widgets for selecting devices and polling and playing midi messages. However, these widgets allow for only one input device and one output device at a time. For a more complex scenario where multiple devices are to be used simultaneously, we have the following four widgets: \begin{spec} midiInM :: UISF [InputDeviceID] (SEvent [MidiMessage]) midiOutM :: UISF [(OutputDeviceID, SEvent [MidiMessage])] () selectInputM :: UISF () [InputDeviceID] selectOutputM :: UISF () [OutputDeviceID] \end{spec} The M on the end can be read as ``Multiple.'' These widgets can be used just like their singular counterparts to handle MIDI, except that they allow for multiple simultaneous device usage. We can add even more behavior into the midi output widgets by considering a \emph{buffered} output. When using |midiOut| (or |midiOutM|), all of the MIDI messages sent to the device are immediately played, but sometimes, we would prefer to queue messages up for playback later. We can do this with the following two midi output widgets: \begin{spec} midiOutB :: UISF ( Maybe OutputDeviceID, BufferOperation MidiMessage) Bool midiOutMB :: UISF [ ( OutputDeviceID, BufferOperation MidiMessage)] Bool \end{spec} Notice that these two widgets have a |Bool| output stream; this stream is |True| when the buffer is empty and there is nothing queued up to play and |False| otherwise. The |BufferOperation| data type gives information along with the MIDI messages about when or how to play the messages. It is defined as follows: \begin{spec} data BufferOperation b = NoBOp | ClearBuffer | SkipAheadInBuffer DeltaT | MergeInBuffer [(DeltaT, b)] | AppendToBuffer [(DeltaT, b)] | SetBufferPlayStatus Bool (BufferOperation b) | SetBufferTempo Tempo (BufferOperation b) \end{spec} where \begin{itemize} \item |NoBOp| indicates that there is no new information for the buffer. \item |ClearBuffer| erases the current buffer. \item |SkipAheadInBuffer t| skips ahead in the buffer by |t| seconds. \item |MergeInBuffer ms| merges messages |ms| into the buffer to play concurrently with what is currently playing. \item |AppendToBuffer ms| adds messages |ms| to the end of the buffer to play immediately following whatever is playing. \item |SetBufferPlayStatus p b| indicates whether the buffer should be playing (|True|) or paused (|False|). \item |SetBufferTempo t b| sets the play speed of the buffer to |t| (the default is 1, indicating realtime). \end{itemize} Note that the final two options recursively take a buffer operation, meaning that they can be attached to any other buffer operation as additional modifications. \syn{The |midiOutB| and |midiOutMB| widgets are essentially the regular |midiOut| widgets connected to an |eventBuffer|. The |eventBuffer| signal function can also be used directly to buffer any kind of data that fits into the |BufferOperation| format. It can be brought into scope by importing FRP.UISF.AuxFunctions.} In practice, the most common time to use the buffered midi output widgets as opposed to the regular ones is when dealing with |Music| values. Thus, Euterpea.IO.MUI.MidiWidgets also exports the following function: \begin{spec} musicToMsgs :: Maybe [InstrumentName] -> Music1 -> [(DeltaT, MidiMessage)] \end{spec} The first argument should be a |Just| value if the |Music1| value is infinite and |Nothing| otherwise. If it is a |Just| value, then its value should be the override for the instrument channels. The |musicToMsgs| function will convert a |Music1| value into a format that can be easily sent to the buffered midi widget. Once converted in this way, it can be wrapped by |MergeInBuffer| or |AppendToBuffer| to be sent to the buffer. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Custom Widgets - Virtual Instruments %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Virtual Instruments} Euterpea provides two special widgets that create virtual instruments that the user can interact with: a piano and a guitar. These two widgets are not fully supported by Euterpea at present, so to bring them into scope, we will need to import Euterpea.Experimental. \begin{spec} import Euterpea.Experimental \end{spec} \syn{Euterpea's Experimental package contains functions and features that are still in process. They may be unreliable, and they are likely to change in future versions of Euterpea. Thus, feel free to experiment with them, but use them with caution.} The piano and guitar are virtual instruments in the MUI that look and behave like a piano keyboard or guitar strings: the strings can be plucked or the piano keys pressed with either the mouse or keyboard, and the output is in the form of MIDI messages. Note that these widgets do not actually produce any sound. Thus, in most cases, the output should then be sent to a MIDI output widget. The two widgets have the following similar types: \begin{spec} guitar :: GuitarKeyMap -> Midi.Channel -> UISF (InstrumentData, SEvent [MidiMessage]) (SEvent [MidiMessage]) piano :: PianoKeyMap -> Midi.Channel -> UISF (InstrumentData, SEvent [MidiMessage]) (SEvent [MidiMessage]) \end{spec} Given a key mapping and a MIDI channel, the functions make the virtual instrument widgets. The widgets themselves accept an |InstrumentData| argument, which contains some settings for the instrument, and a stream of input MIDI messages, and they produce a stream of MIDI messages. They do not make any sound themselves---these widgets are purely visual. Let's look at how these widgets work in a little more detail. First, the widgets take a key map, either a |GuitarKeyMap| or a |PianoKeyMap|. These maps indicate what keyboard keys one can use to play the instruments with a standard computer keyboard. These are customizable values, but we provide a couple for use with a qwerty keyboard: \begin{itemize} \item |defaultMap1| treats the characters from Q to U as one octave from C2 to B3. The black notes are predictably at 2, 3, 5, 6, and 7. Holding a shift key while pressing the same keys plays the notes one octave higher. \item |defaultMap2| is the same as |defaultMap1| except that it uses the bottom two rows of the keyboard, with Z through M as the white keys and S through J (but not F) as black keys. Once again, hold shift for the higher octave. \item |defaultMap0| is for a four octave keyboard and uses both maps in sequence. \end{itemize} For the guitar, we provide |sixString|, a mapping using the first six columns of keys (e.g. 1, Q, A, Z would be the first column) to represent the six strings of the guitar. The next argument to making a virtual instrument widget is a MIDI channel. Because they can create MIDI messages from just a mouse click, these widgets need information about what MIDI channel the messages should use. The |Midi.Channel| type is brought in from |Codec.Midi|, and it is a type synonym for |Int|---really, any number from 0 to 127 is probably an okay candidate, but it depends on what channels your MIDI devices support. The streaming input to the widgets includes both MIDI messages (which will visually ``play'' on the instrument) as well as a value of |InstrumentData|. By default, one should use the value |defaultInstrumentData|, but this can be modified with the following three widgets: \begin{spec} addNotation :: UISF InstrumentData InstrumentData addTranspose :: UISF InstrumentData InstrumentData addPedal :: UISF InstrumentData InstrumentData \end{spec} Each one will create a checkbox or slider to allow for adding notation (visual text that indicates what keys are what on the instrument), transposition (the ability to raise or lower the notes by some amount) or pedal (only used for the piano). Now that we have some idea of how the widgets work, let's create a sample MUI that uses them both. \begin{code} gAndPUI :: UISF () () gAndPUI = proc _ -> do (mi, mo) <- getDeviceIDs -< () m <- midiIn -< mi settings <- addNotation -< defaultInstrumentData outG <- guitar sixString 1 -< (settings, Nothing) outP <- piano defaultMap0 0 -< (settings, m) midiOut -< (mo, outG ~++ outP) gAndP = runMUI (defaultMUIParams { uiSize=(1050,700), uiTitle="Guitar and Piano"}) gAndPUI \end{code} This MUI will provide a checkbox for whether it should display notation or not and then shows both virtual instruments. Any messages played on the input MIDI device will be shown and heard as if played on the virtual piano. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Custom Widgets - A Graphical Canvas %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{A Graphical Canvas} \label{sec:canvas} In addition to the standard musical widgets, the musical user interface provides support for arbitrary graphical output. It does this via the |canvas| widget, which allows the user to ``paint'' graphics right into the MUI: \begin{spec} canvas :: Dimension -> UISF (Event Graphic) () canvas' :: Layout -> (a -> Dimension -> Graphic) -> UISF (Event a) () \end{spec} The main |canvas| widget takes a fixed size and displays in the MUI the most recent |Graphic| it received. The |canvas'| function is a little more complex as it can handle a changing size: rather than a fixed dimension, it accepts a layout and a function that, when given the dimension (which is generated at runtime based on the window size), can produce the appropriate graphic. In either case, the user is responsible for generating the graphic that should be shown by generating a value of type |Graphic|. However, Euterpea does not export |Graphic| constructors by default, so we will need to add the following import to our file: \begin{spec} import FRP.UISF.SOE \end{spec} The name of this import, SOE, comes from the book The Haskell School of Expression, the predecessor to this text. Rather than go into detail about the various types of graphics one can create with this import, we will leave it to the reader to read this other text or to look at the documentation directly. Instead, we will only point out three functions as we will use them in our upcoming example: \begin{spec} rectangleFilled :: Rect -> Graphic rgbE :: Int -> Int -> Int -> RGB withColor' :: RGB -> Graphic -> Graphic \end{spec} The |rectangleFilled| function takes a |Rect|, which is a pair of a point representing the bottom left corner and a width and height, and constructs a rectangle bounded by the |Rect|. The |rgbE| function produces an |RGB| color from red, green, and blue values, and |withColor'| applies the given |RGB| color to the given |Graphic|. In the following example, we will create three sliders to control the red, green, and blue values, and then we will use these to create a simple color swatch out of the |canvas| widget. \begin{code} colorSwatchUI :: UISF () () colorSwatchUI = setSize (300, 220) $ pad (4,0,4,0) $ leftRight $ proc _ -> do r <- newColorSlider "R" -< () g <- newColorSlider "G" -< () b <- newColorSlider "B" -< () e <- unique -< (r,g,b) let rect = withColor' (rgbE r g b) (rectangleFilled ((0,0),d)) pad (4,8,0,0) $ canvas d -< fmap (const rect) e where d = (170,170) newColorSlider l = title l $ withDisplay $ viSlider 16 (0,255) 0 colorSwatch = runMUI' colorSwatchUI \end{code} We use the |polygon| function to create a simple box, and then we color it with the data from the sliders. Whenever the color changes, we redraw the box by sending a new |Graphic| event to the |canvas| widget. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Custom Widgets - [Advanced] mkWidget %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{[Advanced] mkWidget} In some cases, even the |canvas| widget is not powerful enough, and we would like to create our own custom widget. For this, there is the |mkWidget| function. To bring this into scope, we must import UISF's widget module directly: \begin{spec} import FRP.UISF.Widget (mkWidget) \end{spec} The type of |mkWidget| is as follows: \begin{spec} mkWidget :: s -> Layout -> (a -> s -> Rect -> UIEvent -> (b, s, DirtyBit)) -> (Rect -> Bool -> s -> Graphic) -> UISF a b \end{spec} This widget building function takes arguments particularly desgined to make a realtime, interactive widget. The arguments work like so: \begin{itemize} \item The first argument is an initial state for the widget. The widget will be able to internally keep track of state, and the value that it should start with is given here. \item The second argument is the layout of the widget. \item The third argument is the computation that this layout performs. Given an instantaneous value of the streaming input, the current state, the rectangle describing the current allotted dimensions, and the current |UIEvent|\footnote{The |UIEvent| can contain information like mouse clicks or key presses. For complete documentation on |UIEvent|, look to the FRP.UISF documentation.}, it should produce an output value, a new state, and a |DirtyBit|, which is a boolean value indicating whether the visual representation of the widget will change. \item The final argument is the drawing routine. Given the rectangle describing the current allotted dimensions for the widget (the same as given to the computation function), a boolean indicating whether this widget is in focus, and the state, it produces the graphic that this widget will appear as. \end{itemize} The specifics of |mkWidget| are beyond the scope of this text, and those interested in making their own widgets are encouraged to look at the documentation of the UISF package. However, as a demonstration of its use, here we will show the definition of |canvas| using |mkWidget|. \begin{spec} canvas (w, h) = mkWidget nullGraphic layout process draw where layout = makeLayout (Fixed w) (Fixed h) draw ((x,y),(w,h)) _ = translateGraphic (x,y) process (Just g) _ _ _ = ((), g, True) process Nothing g _ _ = ((), g, False) \end{spec} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Advanced Topics %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Advanced Topics} In the final section of this chapter, we will explore some advanced topics related to the MUI. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Advanced Topics - Banana brackets %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Banana brackets} When dealing with layout, we have so far shown two ways to apply the various layout transformers (e.g.\ |topDown|, |leftRight|, etc.) to signal functions. One way involves using the transformer on the whole signal function by applying it on the first line like so: \begin{spec} ... = leftRight $ proc _ -> do ... \end{spec} The other option is to apply the transformation in-line for the signal function it should act upon: \begin{spec} ... x <- topDown mySF -< y ... \end{spec} However, the situation is not so clear cut, and at times, we may want a sub-portion of our signal function to have a different layout flow than the rest. For example, assume we have a signal function that should have four buttons. The second and third buttons should be left-right aligned, but vertically, they together should be between the first and second. One way we may try to write this is like so: \begin{code} ui6 = topDown $ proc _ -> do b1 <- button "Button 1" -< () (b2, b3) <- leftRight (proc _ -> do b2 <- button "Button 2" -< () b3 <- button "Button 3" -< () returnA -< (b2, b3)) -< () b4 <- button "Button 4" -< () display -< b1 || b2 || b3 || b4 \end{code} This looks a little funny, especially because we have an extra arrow tail (the |-<| part) after the inner |returnA| on the sixth line, but it gets the job done. However, what if we wanted to do something with the value |b1| within the inner |proc| part? In its current state, |b1| is not in scope in there. We can add it to the scope, but we would have to explicitly accept that value from the outer scope. It would look like so: \begin{code} ui'6 = topDown $ proc _ -> do b1 <- button "Button 1" -< () (b2, b3) <- leftRight (proc b1 -> do b2 <- button "Button 2" -< () display -< b1 b3 <- button "Button 3" -< () returnA -< (b2, b3)) -< b1 b4 <- button "Button 4" -< () display -< b1 || b2 || b3 || b4 \end{code} This is getting hard to deal with! Fortunately, there is an arrow syntax feature to help us with this known as \emph{banana brackets}. Banana brackets are a component of the arrow syntax that allows one to apply a function to one or more arrow commands without losing the scope of the arrow syntax. To use, one writes in the form: \begin{spec} (| f cmd1 cmd2 ... |) \end{spec} where |f| is a function on arrow commands and |cmd1|, |cmd2|, etc.\ are arrow commands. \syn{An \emph{arrow command} is the portion of arrow syntax that contains the arrow and the input but not the binding to output. Generally, this looks like |sf -< x|, but if it starts with |do|, then it can be an entire arrow in itself (albeit, one that does not start with |proc _ -> |).} Banana brackets preserve the original arrow scope, so we can rewrite our example to: \begin{code} ui''6 = proc () -> do b1 <- button "Button 1" -< () (b2, b3) <- (| leftRight (do b2 <- button "Button 2" -< () display -< b1 b3 <- button "Button 3" -< () returnA -< (b2, b3)) |) b4 <- button "Button 4" -< () display -< b1 || b2 || b3 || b4 \end{code} Note that we no longer need the |proc _ ->| in the third line nor do we have an arrow tail on the seventh line. That said, banana brackets do have a limitation in that the variables used internally are not exposed outside; that is, we still need the seventh line to explicitly return |b2| and |b3| in order to bind them to the outer scope in the third line so that they are visible when displayed on the last line. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Advanced Topics - General I/O From Within a MUI %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{General I/O From Within a MUI} \label{sec:mui-general-io} So far, through specific widgets, we have shown how to perform specific effects through the MUI: one can poll MIDI devices, send MIDI output, display graphics on the screen, and so on. However, the MUI is capable of arbitrary |IO| actions. In general, arbitrary |IO| actions can be dangerous, so the functions that allow them are relegated to Euterpea.Experimental, and they should be used with care. The first arbitrary |IO| arrow to consider is: \begin{spec} initialAIO :: IO d -> (d -> UISF b c) -> UISF b c \end{spec} This function allows an |IO| action to be performed upon MUI initialization, the result of which is used to finish constructing the widget. Thus, its name can be read as ``initial Arrow IO.'' In practice one might use |initialAIO| to do something like read the contents of a file to be used at runtime. For instance, if we had a file called ``songData'' that contained data we would like to use in the MUI, we could use the following function: \begin{spec} initialAIO (readFile "songData") (\x -> now >>> arr (fmap $ const x)) :: UISF () (SEvent String) \end{spec} This function will read the file and then produce a single event containing the contents of the file when the MUI first starts. Performing an initial action is simple and useful, but at times, we would like the freedom to perform actions mid-execution as well, and for that, we have the following six functions: \begin{spec} uisfSource :: IO c -> UISF () c uisfSink :: (b -> IO ()) -> UISF b () uisfPipe :: (b -> IO c) -> UISF b c uisfSourceE :: IO c -> UISF (SEvent ()) (SEvent c) uisfSinkE :: (b -> IO ()) -> UISF (SEvent b) (SEvent ()) uisfPipeE :: (b -> IO c) -> UISF (SEvent b) (SEvent c) \end{spec} The first three of these are for continuous-type actions and the last three are for event-based actions. As an example of a continuous action, one could consider a stream of random numbers: \begin{spec} uisfSource randomIO :: Random r => UISF () r \end{spec} Most |IO| actions are better handled by the event-based functions. For instance, we could update our file reading widget from earlier so that it is capable of reading a dynamically named file, and it can perform more than one read at runtime: \begin{spec} uisfPipeE readFile :: UISF (SEvent FilePath) (SEvent String) \end{spec} Whenever this signal function is given an event containing a file, it reads the file and returns an event containing the contents. \syn{This sort of arbitrary |IO| access that the functions from this subsection allow can have negative effects on a program ranging from unusual behavior to performance problems to crashing. Research has been done to handle these problems, and a promising solution using what are called \emph{resource types} has been proposed \cite{WinogradCort-TR1446, WinogradCort2012HS}. However, Euterpea does not implement resource types, so it is left to the programmer to be exceptionally careful to use these appropriately.} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Advanced Topics - Asynchrony %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \subsection{Asynchrony} Although we have discussed the MUI as being able to act both continuously and discretely (event-based) depending on the required circumstances, in actual fact, the system is entirely built in a discrete way. When run, the MUI does many calculations per second to create the illusion of continuity, and as long as this sample rate is high enough, the illusion persists without any problem. However, there are two primary ways in which the illusion of continuity fails: \begin{itemize} \item Computations can be sensitive to the sampling rate itself such that a low enough rate will cause poor behavior. \item Computations can be sensitive to the variability of the sampling rate such that drastic differences in the rate can cause poor behavior. \end{itemize} These are two subtly different problems, and we will address both with subtly different forms of \emph{asynchrony}. The idea of using asynchrony is to allow these sensitive computations to run separately from the MUI process so that they are unaffected by the MUI's sampling rate and are allowed to set and use their own arbitrary rate. We achieve this with the following functions: \begin{spec} asyncUISFE . toAutomaton :: NFData b => SF a b -> UISF (SEvent a) (SEvent b) clockedSFToUISF :: (NFData b, Clock c) => DeltaT -> SigFun c a b -> UISF a [(b, Time)] \end{spec} Note that the |SF| and |SigFun| types will be discussed further in Chapter~\ref{ch:sigfuns}), but they are both arrows, and thus we can lift pure functions of type |a -> b| to them with the |arr| function. These two functions are designed to address the two different sampling rate pitfalls we raised above. \begin{itemize} \item |asyncUISFE . toAutomaton| is technically a composition of two functions, but in Euterpea, it would be rare to use them apart. Together, they are used to deal with the scenario where a computation takes a long time to compute (or perhaps blocks internally, delaying its completion). This slow computation may have deleterious effects on the MUI, causing it to become unresponsive and slow, so we allow it to run asynchronously. The computation is lifted into the discrete, event realm, and for each input event given to it, a corresponding output event will be created eventually. Of course, the output event will likely not be generated immediately, but it will be generated eventually, and the ordering of output events will match the ordering of input events. \item The |clockedSFToUISF| function can convert a signal function with a fixed, virtual clockrate to a realtime UISF. The first input parameter is a buffer size in seconds that indicates how far ahead of real time the signal function is allowed to get, but the goal is to allow it to run at a fixed clockrate as close to realtime as possible. Thus, the output stream is a list of pairs providing the output values along with the timestamp for when they were generated. This should contain the right number of samples to approach real time, but on slow computers or when the virtual clockrate is exceptionally high, it will lag behind. This can be checked and monitored by checking the length of the output list and the time associated with the final element of the list on each time step. \end{itemize} Rather than show an example here, we will wait until Chapter~\ref{ch:spectrum-analysis} once the |SigFun| type has been introduced. An example that uses |clockedSFToUISF| can be found at the end of the chapter in Figure~\ref{fig:fft-mui} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%% Exercises %%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \vspace{.1in}\hrule \begin{exercise}{\em Define a MUI that has a text box in which the user can type a pitch using the normal syntax |(C,4)|, |(D,5)|, etc., and a pushbutton labelled ``Play'' that, when pushed, will play the pitch appearing in the textbox. Hint: use the Haskell function |reads :: Read a => String -> [(a,String)]| to parse the input.} \end{exercise} \begin{exercise}{\em Modify the previous example so that it has \emph{two} textboxes, and plays both notes simultaneously when the pushbutton is pressed.} \end{exercise} \begin{exercise}{\em Modify the previous example so that, in place of the pushbutton, the pitches are played at a rate specified by a horizontal slider.} \end{exercise} \begin{exercise}{\em Define a MUI for a pseudo-keyboard that has radio buttons to choose one of the 12 pitches in the conventional chromatic scale. Every time a new pitch is selected, that note is played.} \end{exercise} \begin{exercise}{\em Modify the previous example so that an integral slider is used to specify the octave in which the pitch is played.} \end{exercise} \begin{exercise}{\em Leon Gruenbaum describes a ``Samchillian Tip Tip Tip Cheeepeeeee,'' a MIDI keyboard based on intervals rather than fixed pitches. Your job is to define a ``Cheepie Samchillian'' as a MUI that has the following features: \begin{itemize} \item A three-element radio button to choose between three scales: chromatic, major, and whole-tone. \item Nine pushbuttons, corresponding to intervals (within the selected scale) of 0, +1, +2, +3, +4, -1, -2, -3, and -4. \end{itemize} } \end{exercise} \vspace{.1in}\hrule