Main program for Multiple Counters.
import Fudgets
import MultiF
main = fudlogue multipleCounter
We now employ multiF to handle multiple
views and copying. We need to specify the state fudget and the view
fudget.
multipleCounter = multiF state (vBoxF view) s0
The state is represented as a pair of an integer (representing the
counter, of course) and a boolean, which is true if we should
auto-increment.
type State = (Int,Bool)
s0 = (0,False)
The commands that the view sends are clicks from the increment button,
or a boolean value from the toggle button.
data View = Increment | Auto Bool
The state uses timerF
to implement the period increment. The stream processor
count
controls the timer by means of controlF
.
state :: State -> F View State
state s0 = controlF (count s0) timer
where
timer :: F Bool Tick
timer = timerF >=^< prep where
prep True = Just (i,i)
prep False = Nothing
i = argReadKey "interval" 500
toTimer = Left
toOut = Right
The counting stream processor reacts to incoming ticks or view
commands, and outputs a new state.
count :: State -> SP (Either Tick View) (Either Bool State)
count s@(n,t) = putsSP [toTimer t,toOut s] $
getSP $ \msg -> case msg of
Right viewCmd -> case viewCmd of
Auto t' -> count (n+1,t')
Increment -> increment
Left Tick -> increment
where increment = count (n+1,t)
The view is a parallel composition of an integer display, a toggle
button, and push button. The preprocessor splitSP
splits the state and sends the parts to the display and the toggle button.
view :: F State View
view = post >^=<
((intDispF >+< toggleF ("Auto")) >+< buttonF "Increment")
>=^< Left >=^^< splitSP
where
post :: Either (Either a Bool) Click -> View
post (Left (Right t)) = Auto t
post (Right Click) = Increment
toggleF :: String -> F Bool Bool
toggleF s = inputFilterF (toggleButtonF s)
Currently, a high level message to a toggle button passes through, but
here we don't want that. The filter inputFilterF
removes
this ``through way'' traffic.
inputFilterF :: F a b -> F a b
inputFilterF f = loopThroughRightF (absF (ctrl 0)) f where
ctrl n = same where
same = getSP $ \msg -> case msg of
Left m -> if n > 0 then ctrl (n-1) else putSP (Right m) same
Right m -> putSP (Left m) $ ctrl (n+1)