Some Fruit layout code

FruitFragments.as

-- Apply an affine transform (passed as static arg)
-- to any GUI:
transformGUI :: Transform -> GUI b c -> GUI b c
transformGUI tf g = proc (inp, b) ->
  (pic, c) <- g -< (inverse tf %$ inp, b)
  returnA -< (tf %$ pic, c)
  
-- Dynamic version of TransformGUI
-- Takes Transform input signal instead of
-- static arg:
dynTransformGUI :: GUI b c -> GUI (Transform,b) c
dynTransformGUI g = proc (inp,(tf,b)) -> do
  (pic,c) <- g -< (inverse tf %$ inp, b) 
  returnA -< (tf %$ pic, c)

-- dynamically clip a GUI's input signal using the given rectangle.
-- Note that this does NOT clip the GUI's output picture signal
dynClipGUI :: GUI a b -> GUI (G.Rectangle,a) b
dynClipGUI g = proc (inpS,(rectS,aS)) -> do
  let clipInpS = G.clipRect rectS inpS
  (noClipPicS,bS) <- g -< (clipInpS,aS)
  returnA -< (noClipPicS, bS)

-- Now for the real GUI layout combinators:
-- dynFilterGUI:  Interpose dynamic (time-varying) input and output
-- filters on a GUI's GUInput and Picture output signals:
type GUIInFilter = GUIInput -> GUIInput
type GUIOutFilter = G.Picture -> G.Picture

dynFilterGUI :: GUI a b -> GUI (GUIInFilter,GUIOutFilter,a) b
dynFilterGUI g = proc (inpS,(ifS,ofS,aS)) -> do
  let fInpS = ifS inpS
  (picS,bS) <- g -< (fInpS, aS)
  let fPicS = ofS picS
  returnA -< (fPicS,bS)

-- interpose a filter only on a GUI's input signal:
dynInFilterGUI :: GUI a b -> GUI (GUIInFilter,a) b
dynInFilterGUI g = proc (inpS,(ifS,aS)) -> do
  let fInpS = ifS inpS
  g -< (fInpS, aS)

-- Given an AffineTransform tf, produce a (GUIInFilter,GUIOutFilter) pair
-- that will apply the appropriate transforms to achieve the same effect
-- as transformGUI tf:
transFilters :: G.Transform -> (GUIInFilter,GUIOutFilter)
transFilters tf =
  let mkInFilter t = \inp -> t G.%$ inp
      mkOutFilter t = \pic -> t G.%$ pic
  in (mkInFilter (G.inverse tf),mkOutFilter tf)

-- Given a clipping rectangle, return a GUIInFilter that will clip
-- the GUIInput signal by that amount
clipInFilter :: G.Rectangle -> GUIInFilter
clipInFilter = G.clipRect

-- Given a clipping rectangle, do "inverse" clipping: return all
-- values outside the clipping rectangle:
invClipInFilter :: G.Rectangle -> GUIInFilter
invClipInFilter = G.invClip

-- Given a function for computing a spatial transform to apply to g2
-- from the bounds of g1, and a function for computing how to
-- combine the two pictures, layout two GUIs:
layoutGUI :: (G.Rectangle -> G.Transform) ->
  (G.Transform -> G.Picture -> G.Picture -> G.Picture) ->
	     GUI a b -> GUI c d -> GUI (a,c) (b,d)
layoutGUI mkTF combinePics g1 g2 =
  let 
      emptyBounds = G.rectangle G.origin 0 0
  in proc (inpS, (aS,cS)) -> do
  rec (g1PicS, bS) <- dynClipGUI g1 -< (inpS, (g1BoundsS, aS))
      g1BoundsS <- iPre emptyBounds -< extent g1PicS
      let g2TF = mkTF g1BoundsS
      let (transIF,transOF) = transFilters g2TF
      let cmpIF = transIF . (invClipInFilter g1BoundsS)
      (g2PicS, dS) <- dynInFilterGUI g2 -< (inpS,(cmpIF,cS))
      let picS = combinePics g2TF g1PicS g2PicS
  returnA -< (picS, (bS,dS))

aboveGUI :: GUI b c -> GUI d e -> GUI (b,d) (c,e)
aboveGUI = layoutGUI (\r -> G.xyTranslate 0 (rectMaxY r)) (\t -> G.vcomp)

besideGUI :: GUI b c -> GUI d e -> GUI (b,d) (c,e)
besideGUI = layoutGUI (\r -> G.xyTranslate (rectMaxX r) 0) (\t -> G.hcomp)