module MultiF(multiF,controlF) where import FudgetsEach view adds buttons for Copy and Link. These buttons produce messages in the type
ViewCmds
.
data ViewCmds = VCopy | VLinkThe combinator
loopThroughRightF
is used here to let a stream processor control a fudget.
controlF ctrl f = loopThroughRightF (absF ctrl) f multiF :: (s -> F v s) -> F s v -> s -> F a b multiF state_fudget view_fudget s0 = controlF (createGroup 0 s0 $ gctrl 1) dynListF whereInitially, we spawn a group with state
s0
.
toDyn = Left createGroup i s = putSP (toDyn (i, DynCreate (groupHandler s i)))The function
gctrl
will create new group handlers whenever an old
group outputs a state, using the dynListF
.
gctrl n = same where same = getSP $ \msg -> case msg of Left (i, s) -> createGroup n s $ gctrl (n+1) Right outside -> same -- ignoredThe group handler takes as argument an initial state, and an identifier number to be placed in the window title of the views.
groupHandler :: s -> Int -> F a s groupHandler s myId = controlF (createView 0 $ vctrl s 1) (idRightF (state_fudget s) >==< (snd >^=< dynListF)) whereThe output from the views inside the
dynListF
are fed
into the state fudget, unless it's a view command, in which case it
goes directly to the control stream processor vctrl
.
Views are created in createView
by combining the view
fudget with additional buttons and putting it in a shellF
.
createView i = putSP (dyn (i, DynCreate view)) where view = shellF (show myId) (view_fudget >+< buttons) >=^< Left buttons = bf "Copy" VCopy >*< bf "Link" VLink bf str cmd = const cmd >^=< buttonF strThe control stream processor
vctrl
broadcasts state
messages from the state fudget to all views. It also creates new views
if demanded, or outputs the state to the gctrl
if a new
group is to be created.
vctrl s n = same where same = getSP $ \msg -> case msg of Left inside -> case inside of Left s' -> update s' Right cmd -> case cmd of VCopy -> putSP (out s) same VLink -> createView n $ putSP (toView n s) $ vctrl s (n+1) Right outside -> same -- ignored update s' = putsSP [toView i s' | i <- [0..n-1]] $ vctrl s' n toView i s = dyn (i,DynMsg s) out = Right dyn = Left