Display abstract panel widgets

\begin{code}
module DisplayPItem where
import Widget
import WH
import FranCore
import List
import Maybe
import PileArray
import Monad
import FM
import IOExts
import Identify
import PrimWidget
import MapG
import DisplaySimple
import BVar
import GUIDef
import GUI(csetAllB')
import WidgetExports(validPanelConfigs)
\end{code}

The exported display functions.
display a widget in a window, and the more primitive 
display a widget in a panel with some input listener (for windows in canvases).

\begin{code}

displayWidget :: WW -> WidgetB -> GUIDef -> IO ()
displayWidget (WW ww) w gui = do
 p <- getWinPanel ww
 displayWidgetWith Nothing p w gui

displayWidgetWith :: Maybe Bind
	       -> Panel -> WidgetB -> GUIDef -> IO ()
displayWidgetWith mb p w gui = do
 wr <- newWire
 die <- fireListener (input wr)
 addFinaliserW p (die ())
 di <- initDisplayInfo' (currentStyle gui) gui (event wr) 
 pi <- initPackDisplayInfo p
 let di' = maybe di (\a -> di {bindEvents = [a]}) mb
 displayW displayWidget' groupPItem di' pi w
\end{code}

An abstract panel widget has some packing info in scope; 
a current packing mode (ie above or beside);
a current box we're packing into;
a pile array for that box;
a map to get back unique pile names from widget pile names.

\begin{code}
data PackDisplayInfo = PackDisplayInfo {
	packInfo :: ! (Behavior [PackInfo]),
	packMode :: ! (Maybe PackMode),
	packBox :: ! Box,
	packArray :: ! PileArray,
	packFM :: ! (IORef (FiniteMap Ident EltName))
	}

initPackDisplayInfo :: Panel -> IO PackDisplayInfo
initPackDisplayInfo p = do
  bx <- setBoxLayout p
  pa <- pileArray 30
  ref <- newIORef emptyFM
  return $! PackDisplayInfo (lift0 []) Nothing bx pa ref
\end{code}

Display an individual item. To show it we use dispPItem. this returns a hide
action, that we hang onto in an IORef. to hide we then fire the function in 
the IORef.

\begin{code}
displayPItem :: (Bindable w,PanelItem w) => 
                w -> PackDisplayInfo -> DisplayInfo 
                -> IO (EltName,IORef Remover)
displayPItem w (PackDisplayInfo {packInfo = ps,packBox = frm,packArray = pa})
               di = do
  rmvref <- newIORef (return ())
  let showIt elt ps = dispPItem pa elt ps w frm rmvref
      hideIt = do
         readIORef rmvref >>= id
	 writeIORef rmvref (return ())
  elt <- displayPAItem pa w (\disp b -> lift2 disp b ps) showIt hideIt di []
  return (elt,rmvref)
\end{code}

how to map a widget into a box. we lookup in the pilearray which element
to place the widget after.

\begin{code}
dispPItem :: PanelItem w => 
	        PileArray -- the pile for the current box 
	     -> EltName -- the pile name of the widget
             -> [PackInfo] -- the current packing info for the widget
             -> w -- the widget
             -> Box -- the current box
             -> IORef Remover -- the ioref to stick the hide action in
             -> IO ()
dispPItem pa elt ps w box rmvref = do 
       mbe <- findEltAbove pa elt
       rm <- boxAdd w box (maybe PlaceBottom (PlaceBefore . identElt) mbe) ps
       writeIORef rmvref rm
\end{code}

how to make a group of widgets for restacking 
(from left to right, or top to bottom).
we make a box for the pile, individual boxes for each pile element
and just restack that box
\begin{code}

groupPItem :: DisplayInfo -> PackDisplayInfo 
	   -> IO (MkMoveOp PackDisplayInfo)
groupPItem di pi = do
 (_,di,pi) <- newBox'' pi di
 return (di,pi,newBox' )
\end{code}

make a pile element box. we make a new box, and then make a mover,
that just remaps the panel that formed the box after altering its 
position in the pile.

\begin{code}
newBox' :: MkMoveOp' PackDisplayInfo
newBox' di@(DisplayInfo {visible = vis,dieE = dieE}) 
	pd@(PackDisplayInfo {packBox = b,packInfo =i,packFM = fmv,
                             packArray = pa}) 
        ident pos = do
      ((elt,rmvref,p),di,pd) <- newBox'' pd di
      moveInPile <- mkMover pa fmv ident elt raisePileElt lowerPileElt dieE
      moveInPile pos
      let move = mkL $ \pos -> do 
           moveInPile pos
	   t <- getFranTime
	   (ps,vis) <- pairB i vis `at` t
           when vis $ dispPItem pa elt ps p b rmvref
      return (move,di,pd)
\end{code}

make a box to hold a group.
this returns the eltname of the box;
the remover action for the box (to hide it);
and the panel that forms the box (in order to remap it on movement).

as we can just unmap and map this new panel on visibility changes,
we don't need to pass on visibility changes to the elements in it.

(If we try to reuse the same widget in two places this optimisation 
causes us to screw up, but its useful the rest of the time. Rethink?)

\begin{code}
newBox'' :: PackDisplayInfo -> DisplayInfo 
         -> IO ((EltName,IORef Remover,Panel),
                DisplayInfo,PackDisplayInfo)
newBox'' pd@(PackDisplayInfo {packMode = m,
			      packBox = b@(Box bb ref _),packArray = pa}) 
       di@(DisplayInfo {guiDef_ = g,visible = vis,dieE = dieE,style =s}) = do
      p' <- mkSubPanel bb
      runGUI g $ csetAllB' validPanelConfigs p' [] s
      p <- setBoxLayout p'
      addListener (onceE' dieE) $ mkL_ $ destroy p'
      boxSetMode p (maybe PackAbove id m)
      (elt,rmvref) <- displayPItem p' pd di   
      pa' <- pileArray 20
      ref <- newIORef emptyFM
      return ((elt,rmvref,p'),
              di {visible = trueB},
              pd {packFM = ref,packBox = p,packArray = pa',
                  packInfo = lift0 []})
\end{code}

make a new box when the mode changes, ie when we start packing above instead
of beside, and place it in the new pack display info. 

\begin{code}
newBox :: PackDisplayInfo -> DisplayInfo -> PackMode 
       -> IO (PackDisplayInfo,DisplayInfo)
newBox pd@(PackDisplayInfo {packInfo =i,packMode = m,
			    packBox = b@(Box bb ref _),packArray = pa}) 
       di@(DisplayInfo {visible = vis}) pm = do
  case m of 
   Nothing -> do boxSetMode b pm
                 return (pd {packMode = Just pm},di)
   Just m -> 
     if m == pm then 
       return (pd,di)
     else do
      (_,di,pd) <- newBox'' (pd {packMode = Just pm}) di
      return (pd,di)
\end{code}

How to display an abstract panel widget. it is either made of packing info;
a mode change (above/beside); or an actual panel widget.

\begin{code}
displayWidget' :: DisplayInfo -> PackDisplayInfo -> PW -> IO ()
displayWidget' di pd@(PackDisplayInfo {packInfo = ps}) 
               (WithPack pinfo w) = do
  displayW displayWidget' groupPItem di (pd {packInfo = lift0 pinfo}) w
displayWidget' di pd@(PackDisplayInfo {packInfo = ps})
		  (WithPackB pinfo w) = do
  displayW displayWidget' groupPItem di (pd {packInfo = pinfo}) w
displayWidget' di pd
	       (WithPackMode pm w) = do
  (pd,di) <- newBox pd di pm
  displayW displayWidget' groupPItem di pd w
displayWidget' di pd (PW w) = do
  displayPItem w pd di
  return ()
\end{code}