Franttk primitive widgets, these have added functionality on top of the 
underlying toolkit widgets.

\begin{code}
module PrimWidget (module PrimWidget,PrimWidget)where
import GUI
import IOExts
import Weak
import Compatibility
import MutSet
import Maybe
import Monad
import WH
import FRPWrap hiding (addListener)
import WidgetExports
import FranPrim (debugMsg,setFranTime,runFranOnce,wrapIOL,Event,Listener,
                 addListener,tellL,neverE,primNewWire,Wire(..))
import Conf
\end{code}


Recall from GUIDef.lhs the definition of PrimWidget and friends

type RemRef = IORef (Maybe Remover)

type Window = PrimWidget WindowPrim
type Canvas = PrimWidget CanvasPrim

A primwidget has an addingRef used in primAdd to control redisplaying of 
widgets (see primAdd), access to the GUIDef state from when it was create,
the widget itself, an action to hide the widget, a weak reference to the 
hide action, and an event that listens to all command actions on the widget.

data PrimWidget w = PrimWidget {
	addingRef :: IORef Int,
	guiDef :: ! GUIDef,
	widgetPrim :: ! w,
	hideRef :: ! RemRef,
	hideRefWP :: ! (Weak RemRef),
	actionPE :: Event ()
	}


making a prim widget. We get the current gui def. We create the widget
using the current window. We make a reference to hold the hide action
for the widget. We then create a weak reference to this hide ref, with
a finaliser that destroys the widget. Recall that in GUIDef there is
a mutable list of visible items. When a widget is visible, then its
hide ref goes in this list. Therefore this ref cell remains live until
the widget becomes invisible and there are no other references to it
that could make it visible again. At this point we can safely destroy 
the widget.

\begin{code}
mkPrimWidget' :: WidgetItem w => 
                (WindowPrim -> [Config] -> GUIInfo -> IO w) 
	     -> [ConfigName]
             -> [Conf (PrimWidget w)] 
	     -> (PrimWidget w -> GUI (PrimWidget w))
             -> GUI (PrimWidget w)
mkPrimWidget' mk valids cs alter = do
 info <- getGUIDef
 s <- getStyle
 (act,prim) <- liftIO $ do
  aref <- newIORef 0
  case getConfigs valids s cs of 
   (cs,as) -> do
     w <- mk (widgetPrim $ currentWindow info) cs (guiInfo info)
     ref <- newIORef Nothing
     wp <- mkWeakIORef ref (debugMsg ("kill",uniqueId w) >> destroy w)
     return $! (as,PrimWidget aref info w ref wp neverE)

 -- this alter action may change the action listener event to be a real
 -- one if so, then the act function will probably attempt to add action
 -- listeners so order of these two operations matters
 prim <- alter prim
 act prim
 return prim

mkPrimWidget :: WidgetItem w => (WindowPrim -> [Config] -> GUIInfo -> IO w) 
	     -> [ConfigName]
             -> [Conf (PrimWidget w)] 
             -> GUI (PrimWidget w)
mkPrimWidget mk valids cs = mkPrimWidget' mk valids cs (return . id)
\end{code}

make a primitive widget that can have an action listener, so make an event
that connects to the action listener

\begin{code}
mkPrimWidgetAct :: (Has_Action w,WidgetItem w) => (WindowPrim -> [Config] -> GUIInfo -> IO w) 
	     -> [ConfigName]
             -> [Conf (PrimWidget w)] 
             -> GUI (PrimWidget w)
mkPrimWidgetAct mk valids cs = mkPrimWidget' mk valids cs $ \prim -> do
 ev <- actionE (widgetPrim prim)
 return $ prim {actionPE = ev}
\end{code}

action listeners on primwidgets are all merged to connect to a single event,
that listens to actions on the widget. This allows more than one action
listener to be added at a time. We make a primitive repeater with subscribe 
and unsubscribe actions. If the event has no listeners and we add one,
we'll add an actual listener to the widget, when we remove all the listeners 
from the event we also remove the listener on the widget. This reduces 
unnecessary work being done when nothing is interested in the widget.

It is assumed that the underlying toolkit can handle multiple bindings to
other sorts of events. Why? Because there are so many it would be inefficient
to use this technique, and tcl-tk is able to do that. Ok so it may be a bad
assumption but we'll see...

\begin{code}

actionE :: Has_Action w => w -> GUI (Event ())
actionE w = primMkEvent w (\l -> action w $ tellL l ())

primMkEvent :: WidgetItem w => w -> (Listener a -> IO (IO ())) -> GUI (Event a)
primMkEvent w act = 
 withGUIDef $ \g -> do
  fmap wireEvent $ fixIO $ \ ~(Wire l _) -> do
	      rmver <- newIORef (return ())
	      let final = return ()
		  subscribe = do
			act (wrapIOL (primAction g) l) >>= writeIORef rmver 
		  unsubscribe = do readIORef rmver >>= id
				   writeIORef rmver (return ())
              primNewWire  final subscribe unsubscribe 


\end{code}

showing and hiding prim widgets.
When we show the widget we make it active by adding its remover ref to the
active widget set. We then stick the remove action for the set in the remover
ref. When we make the widget inactive we can then just run the remover ref.

\begin{code}

-- the Bool says did we need to remap the widget
mkActiveWidget :: GUIDef -> RemRef -> IO Bool
mkActiveWidget guiDef ref = do
 mb <- readIORef ref
 if (isJust mb) then 
   return False
  else do
   rm <- addToMutSet (activeWidgets guiDef) ref
   writeIORef ref (Just $ rm)
   return True

-- the bool says did we need to unmap the widget
hideActiveWidget :: RemRef -> IO Bool
hideActiveWidget ref = do
  mb <- readIORef ref
  case mb of
   Nothing -> return False
   Just rm -> do {rm;return True}

-- convenience function to apply previous two functions to a prim widget
-- (used in ComponentWidgets.lhs)
setActiveWidget :: PrimWidget w -> Bool -> IO ()
setActiveWidget (PrimWidget {guiDef = d,hideRef = ref}) b =
  if b then mkActiveWidget d ref >> return ()
  else hideActiveWidget ref >> return ()

\end{code}

We need to be careful when hiding and showing widgets. Why? With a panel
widget it is possible to add a panel item to two different items. Adding it
to a second box makes it vanish from the first. If we try to run the hide
action for the first box, its no longer there. It may, however, still be in
the second box. So removing it from the active list would be disastrous.
We therefore keep a reference to whether it was this action that added. Only
the action that added is allowed to remove.

\begin{code}
primAdd :: (w -> IO Remover) -> PrimWidget w -> IO Remover
primAdd add (PrimWidget {addingRef = aref,guiDef = inf,
		         widgetPrim = w,hideRef = ref,hideRefWP = wp}) = do
   v <- mkActiveWidget inf ref
   i <- readIORef aref
   let myi = i + 1
   writeIORef aref myi
   rm <- add w
   mkRemover $ do
	n <- readIORef aref
	when (n == myi) $ do
 	  refMb <- deRefWeak wp
	  v <- maybe (return False) hideActiveWidget refMb
	  when v $ rm
\end{code}

begin{code}
-- tried reference counting but it seems broken.

primAdd :: (w -> IO Remover) -> PrimWidget w -> IO Remover
primAdd add (PrimWidget {addingRef = aref,guiDef = inf,
		         widgetPrim = w,hideRef = ref,hideRefWP = wp}) = do
   v <- mkActiveWidget inf ref
   i <- readIORef aref
   writeIORef aref (i + 1)
   rm <- add w
   mkRemover $ do
    n <- readIORef aref
    if n > 1 then
      writeIORef aref (n - 1)
     else do
      refMb <- deRefWeak wp
      v <- maybe (return False) hideActiveWidget refMb
      when v $ rm
end{code}

Instances for prim widgets

\begin{code}

--widget item. when we destroy the widget, first remove it from the 
--active set.
instance WidgetItem w => WidgetItem (PrimWidget w) where
 cset (PrimWidget {widgetPrim = w}) = cset w
 destroy (PrimWidget {widgetPrim = w,hideRef = ref}) = do
   readIORef ref >>= maybe (return ()) id
   destroy w
 uniqueId (PrimWidget {widgetPrim = w}) = uniqueId w
 addFinaliserW (PrimWidget {widgetPrim = w}) = addFinaliserW w
 
-- see primAdd for more on special add
instance PanelItem w => PanelItem (PrimWidget w) where
 boxAdd w bx pm ps = primAdd (\w -> boxAdd w bx pm ps) w     
 gridAdd w bx pm ps = primAdd (\w -> gridAdd w bx pm ps) w   

 raise (PrimWidget {widgetPrim = w}) = raise w
 lower (PrimWidget {widgetPrim = w}) = lower w

-- when we show a window item, make it active. when we unmap it make it
-- inactive.
instance WindowItem w => WindowItem (PrimWidget w) where
 showWindow (PrimWidget {guiDef = inf,widgetPrim = w,hideRef = ref}) = do
   v <- mkActiveWidget inf ref
   when v $ showWindow w
 hideWindow (PrimWidget {widgetPrim = w,hideRef = ref}) = do
   v <- hideActiveWidget ref
   when v $ hideWindow w
 iconifyWindow (PrimWidget {widgetPrim = w}) = iconifyWindow w
 getWinPanel (PrimWidget {widgetPrim = w}) = getWinPanel w

-- bind user input to widgets. Note that we make the input a primAction,
-- meaning that after the action happens we have to update behaviors,
-- by running the fran workpool. see GUI.lhs FranPrim.hs and WorkPool.hs
instance Bindable w => Bindable (PrimWidget w) where
 bind (PrimWidget {widgetPrim = w,guiDef = d}) a l = bind w a (wrapIOL (primAction d) l)

-- listen to action commands by listening to the action event
instance Has_Action w => Has_Action (PrimWidget w) where
 action (PrimWidget {actionPE = w,widgetPrim = wg}) l = do
	addListener w l

-- action (PrimWidget {widgetPrim = w,guiDef = d}) l = action w (wrapIOL (primAction d) l)

\end{code}

helpful functions for applying config actions to prim widgets and 
making prim widgets.

\begin{code}

confPIO :: ConfigName -> (w -> IO ()) -> Conf (PrimWidget w)
confPIO nm f = confIO' nm $ \w -> f (widgetPrim w)

confPGUI :: ConfigName -> (w -> GUI ()) -> Conf (PrimWidget w)
confPGUI nm f = confGUI' nm $ \w -> f (widgetPrim w)

-- add a listener for a widget that is removed when the widget is destroyed

addListenerW :: WidgetItem w => Event a -> Listener a -> w -> GUI ()
addListenerW e l w = liftIO $ do
 rm <- addListener e l
 addFinaliserW w rm

-- on an action command apply a function to the widget, passing that value
-- to the listener. Eg for a checkbutton which samples its own check value
-- when clicked.

commandSelf :: Has_Action w => (w -> GUI a) -> Listener a -> Conf w
commandSelf f l = confGUI $ \w -> do l <- mapGUIL (const $ f w) l
				     liftIO $ action w l
				     return ()

-- make a standard prim widget, and action command prim widget,
-- where we don't need access to the GUIInfo part.

mkPWidget :: (WidgetItem w) => 
                (WindowPrim -> [Config] -> IO w) 
	     -> [ConfigName]
             -> [Conf (PrimWidget w)] 
             -> GUI (PrimWidget w)
mkPWidget mk valids cs = mkPrimWidget (\w c _ -> mk w c) valids cs

mkPWidgetAct :: (WidgetItem w,Has_Action w) => 
                (WindowPrim -> [Config] -> IO w) 
	     -> [ConfigName]
             -> [Conf (PrimWidget w)] 
             -> GUI (PrimWidget w)
mkPWidgetAct mk valids cs = mkPrimWidgetAct (\w c _ -> mk w c) valids cs

\end{code}