diff --git a/FRP/UISF.hs b/FRP/UISF.hs --- a/FRP/UISF.hs +++ b/FRP/UISF.hs @@ -1,18 +1,11 @@ module FRP.UISF ( -- UI functions UISF - , UIParams (..) -- data UIParams = UIParams { ... } - , defaultUIParams -- :: UIParams , runUI' -- :: UISF () () -> IO () , runUI -- :: UIParams -> UISF () () -> IO () - , asyncUISFV -- :: NFData b => Double -> Double -> Automaton a b -> UISF a ([b], Bool) - , asyncUISFE -- :: NFData b => Automaton a b -> UISF (SEvent a) (SEvent b) + , UIParams (..) -- data UIParams = UIParams { ... } + , defaultUIParams -- :: UIParams , Dimension -- type Dimension = (Int, Int) - , topDown, bottomUp, leftRight, rightLeft -- :: UISF a b -> UISF a b - , setSize -- :: Dimension -> UISF a b -> UISF a b - , setLayout -- :: Layout -> UISF a b -> UISF a b - , pad -- :: (Int, Int, Int, Int) -> UISF a b -> UISF a b - , getTime -- :: UISF () Time -- Widgets , label -- :: String -> UISF a a , displayStr -- :: UISF String () @@ -29,15 +22,22 @@ , hSlider, vSlider -- :: RealFrac a => (a, a) -> a -> UISF () a , hiSlider, viSlider -- :: Integral a => a -> (a, a) -> a -> UISF () a , realtimeGraph -- :: RealFrac a => Layout -> Time -> Color -> UISF [(a,Time)] () + , Color (..) -- data Color = Black | Blue | Green | Cyan | Red | Magenta | Yellow | White , histogram -- :: RealFrac a => Layout -> UISF (Event [a]) () , histogramWithScale -- :: RealFrac a => Layout -> UISF (SEvent [(a,String)]) () , listbox -- :: (Eq a, Show a) => UISF ([a], Int) Int , canvas -- :: Dimension -> UISF (Event Graphic) () , canvas' -- :: Layout -> (a -> Dimension -> Graphic) -> UISF (Event a) () -- Widget Utilities + , topDown, bottomUp, leftRight, rightLeft -- :: UISF a b -> UISF a b + , pad -- :: (Int, Int, Int, Int) -> UISF a b -> UISF a b + , setSize -- :: Dimension -> UISF a b -> UISF a b + , setLayout -- :: Layout -> UISF a b -> UISF a b , makeLayout -- :: LayoutType -> LayoutType -> Layout , LayoutType (..) -- data LayoutType = Stretchy { minSize :: Int } | Fixed { fixedSize :: Int } - , Color (..) -- data Color = Black | Blue | Green | Cyan | Red | Magenta | Yellow | White + , getTime -- :: UISF () Time + , asyncUISFV -- :: NFData b => Double -> Double -> Automaton a b -> UISF a ([b], Bool) + , asyncUISFE -- :: NFData b => Automaton a b -> UISF (SEvent a) (SEvent b) , module FRP.UISF.AuxFunctions , module Control.Arrow ) where diff --git a/FRP/UISF/AuxFunctions.hs b/FRP/UISF/AuxFunctions.hs --- a/FRP/UISF/AuxFunctions.hs +++ b/FRP/UISF/AuxFunctions.hs @@ -36,13 +36,10 @@ -- (=>>), (->>), (.|.), -- snapshot, snapshot_, - -- * Signal Function Conversions - -- $conversions - -- *** Types + -- * Signal Function Asynchrony + -- $asynchrony Automaton(..), - -- *** Conversions - -- $conversions2 - asyncC, asyncV, asyncE, asyncC' + asyncV, asyncE, asyncC, asyncC' ) where import Prelude hiding ((.), id) @@ -74,23 +71,31 @@ -- | DeltaT is a type synonym referring to a change in Time. type DeltaT = Double --- | Instances of this class have arrowized access to the time +-- | Instances of this class have arrowized access to time. This is +-- convenient in many cases where time is necessary but we would +-- prefer not to make it an explicit argument. class ArrowTime a where time :: a () Time +-- | Instances of the ArrowIO class have an arrowized ability to +-- perform IO actions. class Arrow a => ArrowIO a where + -- | The liftAIO function lifts an IO action into an arrow. liftAIO :: (b -> IO c) -> a b c + -- | The initialAIO function performs an IO action once upon the + -- initialization of the arrow and then uses the result of that + -- action to generate the arrow itself. initialAIO :: IO d -> (d -> a b c) -> a b c -------------------------------------- -- Useful SF Utilities (Mediators) -------------------------------------- --- | constA is an arrowized version of const +-- | constA is an arrowized version of const. constA :: Arrow a => c -> a b c constA = arr . const --- | constSF is a convenience +-- | constSF is a convenience composing 'constA' with the given SF. constSF :: Arrow a => b -> a b d -> a c d constSF s sf = constA s >>> sf @@ -136,7 +141,7 @@ mergeE _ Nothing re@(Just _) = re mergeE resolve (Just l) (Just r) = Just (resolve l r) --- | A nice infix operator for merging event lists +-- | This is an infix specialization of 'mergeE' to lists. (~++) :: SEvent [a] -> SEvent [a] -> SEvent [a] (~++) = mergeE (++) @@ -169,10 +174,11 @@ d <- h -< bs returnA -< merge c d +-- | This is a special case of foldA for lists. runDynamic :: ArrowChoice a => a b c -> a [b] [c] runDynamic = foldA (:) [] --- | For folding results of a list of signal functions +-- | For folding results of a list of signal functions. foldSF :: Arrow a => (b -> c -> c) -> c -> [a () b] -> a () c foldSF f c sfs = let inps = replicate (length sfs) () in constA inps >>> concatA sfs >>> arr (foldr f c) @@ -184,12 +190,18 @@ -- s2 <- sfb -< () -- returnA -< f s1 s2 +-- | This behaves much like the maybe function except lifted to the +-- ArrowChoice level. The arrow behaves like its first argument +-- when the input stream is Nothing and like its second when it is +-- a Just value. maybeA :: ArrowChoice a => a () c -> a b c -> a (Maybe b) c maybeA nothing just = proc eb -> do case eb of Just b -> just -< b Nothing -> nothing -< () +-- | This lifts the arrow to an event-based arrow that behaves as +-- a constant stream of Nothing when there is no event. evMap :: ArrowChoice a => a b c -> a (SEvent b) (SEvent c) evMap a = maybeA (constA Nothing) (a >>> arr Just) @@ -197,9 +209,6 @@ -- Delays and Timers -------------------------------------- --- | delay is a unit delay. It is exactly the delay from ArrowCircuit. - - -- | fdelay is a delay function that delays for a fixed amount of time, -- given as the static argument. It returns a signal function that -- takes the current time and an event stream and delays the event @@ -355,19 +364,22 @@ eventBuffer :: (ArrowTime a, ArrowCircuit a) => a (BufferOperation b) (SEvent [b], Bool) eventBuffer = arr (,()) >>> second time >>> eventBuffer' +-- | eventBuffer' is a version that takes Time explicitly rather than +-- with ArrowTime. eventBuffer' :: ArrowCircuit a => a (BufferOperation b, Time) (SEvent [b], Bool) eventBuffer' = proc (bo', t) -> do let (bo, doPlay', tempo') = collapseBO bo' doPlay <- hold True -< doPlay' tempo <- hold 1 -< tempo' rec tprev <- delay 0 -< t --used to calculate dt, the change in time - buffer <- delay [] -< buffer''' --the buffer + buffer <- delay [] -< buffer' --the buffer let dt = tempo * (t-tprev) --dt will never be negative - buffer' = if doPlay then subTime buffer dt else buffer - buffer'' = update buffer' bo --update the buffer based on the operation - (nextMsgs, buffer''') = if doPlay then getNextEvent buffer'' --get any events that are ready - else (Nothing, buffer'') - returnA -< (nextMsgs, null buffer''') + (nextMsgs, buffer') = if doPlay + -- Subtract delta time, update the buffer, and get any events that are ready + then getNextEvent (update (subTime buffer dt) bo) + -- Regardless, update the buffer based on the operation + else (Nothing, update buffer bo) + returnA -< (nextMsgs, null buffer') where subTime :: [(DeltaT, b)] -> DeltaT -> [(DeltaT, b)] subTime [] _ = [] @@ -423,29 +435,32 @@ -------------------------------------- --- Signal Function Conversions +-- Signal Function Asynchrony -------------------------------------- --- $conversions --- Due to the internal IO, ArrowIO arrows are --- not necessarily pure. Thus, when we run them, we say that they run \"in --- real time\". This means that the time between two samples can vary and is --- inherently unpredictable. --- --- However, sometimes we have a pure computation that we would like to run --- on a simulated clock. This computation will expect to produce values at --- specific intervals, and because it's pure, that expectation can sort of be --- satisfied. For this, we would use asynchV (V for virtual). --- --- The other functions in this section are for other forms of asynchrony. --- There is one for Event-based asynchrony and two for continuous. +{- $asynchrony +Due to the ability for ArrowIO arrows to perform IO actions, they are +obviously not guaranteed to be pure, and thus when we run them, we say +that they run \"in real time\". This means that the time between two +samples can vary and is inherently unpredictable. +However, there are cases when we would like more control over the timing +of certain arrowized computations. For instance, sometimes we have a +pure computation that we would like to run on a simulated clock. This +computation will expect to produce values at specific intervals, and +because it's pure, that expectation can sort of be satisfied. --- $conversions2 --- The following function is for lifting an Automaton to an ArrowIO by --- appropriately converting the "simulated time" Automaton into realtime. +To achieve this, we allow these sub-computations to be performed +asynchronously. The following functions behave subtly differently +to exhibit different forms of asynchrony for different use cases. +-} --- | The clockrate is the simulated rate of the input signal function. +-- | The asyncV functions is for \"Virtual time\" asynchrony. The +-- embedded signal function is given along with an expected +-- clockrate, and the output conforms to that clockrate as well as it +-- can. +-- +-- The clockrate is the simulated rate of the input signal function. -- The buffer is the amount of time the given signal function is -- allowed to get ahead of real time. The threadHandler is where the -- ThreadId of the forked thread is sent. @@ -488,21 +503,17 @@ --- | The asyncE function takes a pure signal function (an Automaton) and converts --- it into an asynchronous signal function usable in a MonadIO signal --- function context. The output MSF takes events of type a, feeds them to --- the asynchronously running input SF, and returns events with the output --- b whenever they are ready. The input SF is expected to run slowly --- compared to the output MSF, but it is capable of running just as fast. --- The input stream is a value, an option to clear any buffered values, or --- nothing, and the output stream is either a result value, a AOCalculating --- indicating that the asynchronous function is calculating and giving the --- buffer size, or nothing. +-- | The asyncE (E for \"Event\") function takes a signal function (an Automaton) and converts +-- it into an asynchronous event-based signal function usable in a ArrowIO signal +-- function context. The output arrow takes events of type a, feeds them to +-- the asynchronously running input signal function, and returns events with the output +-- b whenever they are ready. The input signal function is expected to run slowly +-- compared to the output one, but it is capable of running just as fast. asyncE :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData c) => (ThreadId -> a () ()) -- ^ The thread handler -> (Automaton (->) b c) -- ^ The automaton to convert to asynchronize -> a (SEvent b) (SEvent c) -asyncE threadHandler sf = {- delay AINoValue >>> -} initialAIO iod darr where +asyncE threadHandler sf = initialAIO iod darr where iod = do inp <- newIORef empty out <- newIORef empty @@ -532,10 +543,17 @@ EmptyL -> (s, Nothing) a :< s' -> (s', Just a) --- | asyncC is the continuous async function. +-- | The asyncC (C for \"Continuous time\") function allows a continuous +-- signal function to run as fast as it can asynchronously. There are +-- no guarantees that all input data make it to the asynchronous signal +-- function; if this is required, asyncE should be used instead. +-- Rather, the embedded signal function runs as fast as it can on +-- whatever value it has most recently seen. Its results are +-- bundled together in a list to be returned to the main signal +-- function. asyncC :: (ArrowIO a, NFData c) => (ThreadId -> a () ()) -- ^ The thread handler - -> (Automaton (->) b c) -- ^ The automaton to convert to realtime + -> (Automaton (->) b c) -- ^ The automaton to convert to realtime -> a b [c] --asyncC th sf = asyncC' th (const . return $ (), return) (first sf) asyncC threadHandler sf = initialAIO iod darr where @@ -557,9 +575,8 @@ worker inp out sf' - - --- | A version of asyncC that does actions on either end of the automaton +-- | This is a version of asyncC that does IO actions on either end of +-- the embedded signal function. asyncC' :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData b) => (ThreadId -> a () ()) -- ^ The thread handler -> (b -> IO d, e -> IO ()) -- ^ Effectful input and output channels for the automaton diff --git a/FRP/UISF/Examples/Examples.hs b/FRP/UISF/Examples/Examples.hs --- a/FRP/UISF/Examples/Examples.hs +++ b/FRP/UISF/Examples/Examples.hs @@ -17,7 +17,7 @@ timeEx :: UISF () () timeEx = title "Time" $ getTime >>> display --- | This example shows off buttons and state by presenting a plus and +-- | This example shows off 'button's and state by presenting a plus and -- minus button with a counter that is adjusted by them. buttonEx :: UISF () () buttonEx = title "Buttons" $ topDown $ proc _ -> do @@ -31,7 +31,7 @@ _ -> v) display -< v --- | This example shows off the checkbox widgets. +-- | This example shows off the 'checkbox' widgets. checkboxEx :: UISF () () checkboxEx = title "Checkboxes" $ topDown $ proc _ -> do x <- checkbox "Monday" False -< () @@ -43,20 +43,21 @@ bin True = "1" bin False = "0" --- | This example shows off the radio button widget. +-- | This example shows off the 'radio' button widget. radioButtonEx :: UISF () () radioButtonEx = title "Radio Buttons" $ topDown $ radio list 0 >>> arr (list!!) >>> displayStr where list = ["apple", "orange", "banana"] --- | This example shows off integral sliders (horizontal in the case). +-- | This example shows off integral sliders (horizontal 'hiSlider's in +-- this case). shoppinglist :: UISF () () shoppinglist = title "Shopping List" $ topDown $ proc _ -> do a <- title "apples" $ hiSlider 1 (0,10) 3 -< () b <- title "bananas" $ hiSlider 1 (0,10) 7 -< () title "total" $ display -< (a + b) --- | This example shows off both vertical sliders as well as the canvas +-- | This example shows off both vertical sliders as well as the 'canvas' -- widget. The canvas widget can be used to easily create custom graphics -- in the GUI. Here, it is used to make a color swatch that is -- controllable with RGB values by the sliders. @@ -77,8 +78,8 @@ returnA -< v box ((x,y), (w, h)) = polygon [(x, y), (x + w, y), (x + w, y + h), (x, y + h)] --- | This example shows off the textbox widget. Text can be typed in, and --- that text is transferred to the display widget below when the button +-- | This example shows off the 'textboxE' widget. Text can be typed in, and +-- that text is transferred to the 'display' widget below when the button -- is pressed. textboxdemo :: UISF () () textboxdemo = setLayout (makeLayout (Stretchy 150) (Fixed 100)) $ @@ -90,7 +91,7 @@ returnA -< () -- | This is the main demo that incorporates all of the other examples --- together (except for fftEx). In addition to demonstrating how +-- together. In addition to demonstrating how -- different widgets can connect, it also shows off the tabbing -- behavior built in to the GUI. Pressing tab cycles through focuable -- elements, and pressing shift-tab cycles in reverse. diff --git a/FRP/UISF/UISF.hs b/FRP/UISF/UISF.hs --- a/FRP/UISF/UISF.hs +++ b/FRP/UISF/UISF.hs @@ -161,29 +161,29 @@ -- * UISF Getters and Convenience Constructor ------------------------------------------------------------ --- | Get the time signal from a UISF +-- | Get the time signal from a UISF. getTime :: UISF () Time getTime = mkUISF nullLayout (\(_,f,t,_,_) -> (False, f, nullGraphic, nullTP, t)) --- | Get the context signal from a UISF +-- | Get the context signal from a UISF. getCTX :: UISF () CTX getCTX = mkUISF nullLayout (\(c,f,_,_,_) -> (False, f, nullGraphic, nullTP, c)) --- | Get the UIEvent signal from a UISF +-- | Get the UIEvent signal from a UISF. getEvents :: UISF () UIEvent getEvents = mkUISF nullLayout (\(_,f,_,e,_) -> (False, f, nullGraphic, nullTP, e)) --- | Get the focus data from a UISF +-- | Get the focus data from a UISF. getFocusData :: UISF () Focus getFocusData = mkUISF nullLayout (\(_,f,_,_,_) -> (False, f, nullGraphic, nullTP, f)) --- | A thread handler for UISF. +-- | Add a termination procedure to a UISF. addTerminationProc :: IO () -> UISF a a addTerminationProc p = UISF (const nullLayout) fun where fun (_,f,_,_,b) = return (False, f, nullGraphic, Just p, b, UISF (const nullLayout) fun2) fun2 (_,f,_,_,b) = return (False, f, nullGraphic, Nothing, b, UISF (const nullLayout) fun2) --- | Get the mouse position from a UISF +-- | Get the mouse position from a UISF. getMousePosition :: UISF () Point getMousePosition = proc _ -> do e <- getEvents -< () diff --git a/FRP/UISF/UITypes.hs b/FRP/UISF/UITypes.hs --- a/FRP/UISF/UITypes.hs +++ b/FRP/UISF/UITypes.hs @@ -18,51 +18,57 @@ -- * UI Types ------------------------------------------------------------ --- $uitypes --- Widgets are arrows that map multiple inputs to multiple outputs. --- Additionally, they have a relatively static layout argument that, --- while it can change over time, is not dependent on any of its --- inputs at any given moment. --- --- On the input end, a widget will accept: --- --- - a graphical context, --- --- - some information about which widget is in focus (for the purposes --- of routing key presses and mouse clicks and potentially for drawing --- the widget differently), --- --- - and the current time. --- --- On the output end, a widget will produce from these inputs: --- --- - an indicator of whether the widget needs to be redrawn, --- --- - any focus information that needs to be conveyed to future widgets, --- --- - the graphics to render to display this widget, --- --- - and any new ThreadIds to keep track of (for proper shutdown when finished). --- --- Additionally, as widgets are generic arrows, there will be a parameterized --- inputs and output type. --- --- In this file, we will declare the various types to make creating the overall --- UI possible. For the widget type itself, see UISF in FRP.UISF.UISF. +{- $uitypes +In this module, we will declare the various types to make creating the +overall UI possible. We will discuss the ideas for widgets in some +detail, but for specifics on the type of a widget (the 'UISF' type), +see the UISF type in "FRP.UISF.UISF", and for information on specific +widgets, see "FRP.UISF.Widget". +Widgets are arrows that map multiple inputs to multiple outputs. +Additionally, they have a relatively static layout argument that, +while it can change over time, is not dependent on any of its +inputs at any given moment. +On the input end, a widget will accept: + + - a graphical context, + + - some information about which widget is in focus (for the purposes + of routing key presses and mouse clicks and potentially for drawing + the widget differently), + + - and the current time. + + - an event with data relating to UI actions. + +On the output end, a widget will produce from these inputs: + + - an indicator of whether the widget needs to be redrawn, + + - any focus information that needs to be conveyed to future widgets, + + - the graphics to render to display this widget, + + - and a procedure to run upon termination (for proper shutdown when finished). + +Additionally, as widgets are generic arrows, there will be a parameterized +input and output types. + +-} + ------------------------------------------------------------ -- * Control Data ------------------------------------------------------------ --- | The control data is simply a list of Thread Ids. +-- | The termination procedure is simply a potential IO action. type TerminationProc = Maybe (IO ()) --- | No new thread ids. +-- | The null termination procedure is no action. nullTP :: TerminationProc nullTP = Nothing --- | A method for merging to control data objects. +-- | A method for merging two termination procedures. mergeTP :: TerminationProc -> TerminationProc -> TerminationProc mergeTP = mergeE (>>) @@ -114,9 +120,9 @@ -- so we have this convenience function for their creation. -- This function takes layout information for first the horizontal -- dimension and then the vertical. -makeLayout :: LayoutType -> -- ^ Horizontal Layout information - LayoutType -> -- ^ Vertical Layout information - Layout +makeLayout :: LayoutType -- ^ Horizontal Layout information + -> LayoutType -- ^ Vertical Layout information + -> Layout makeLayout (Fixed h) (Fixed v) = Layout 0 0 h v 0 0 makeLayout (Stretchy minW) (Fixed v) = Layout 1 0 0 v minW 0 makeLayout (Fixed h) (Stretchy minH) = Layout 0 1 h 0 0 minH diff --git a/ReadMe.txt b/ReadMe.txt --- a/ReadMe.txt +++ b/ReadMe.txt @@ -17,7 +17,7 @@ ==== Getting the Source ==== ============================ -Currently (1/10/2015), the most up-to-date version of UISF is +Currently (1/14/2015), the most up-to-date version of UISF is available through GitHub at: https://github.com/dwincort/UISF diff --git a/UISF.cabal b/UISF.cabal --- a/UISF.cabal +++ b/UISF.cabal @@ -1,5 +1,5 @@ name: UISF -version: 0.3.0.0 +version: 0.3.0.1 Cabal-Version: >= 1.8 license: BSD3 license-file: License @@ -9,7 +9,7 @@ build-type: Simple author: Dan Winograd-Cort maintainer: Dan Winograd-Cort -bug-reports: mailto:dwc@cs.yale.edu +bug-reports: https://github.com/dwincort/UISF/issues homepage: http://haskell.cs.yale.edu/ synopsis: Library for Arrowized Graphical User Interfaces. description: