An abstract widget. May be dynamic and map down onto several primitive widgets.
There is a generic abstract widget and then there are several types of 
specific Widget: 
representing top level windows (WindowWidgetB); 
widgets, such as buttons, that live inside top level windows (WidgetB); 
and canvas items, that live in canvases (CanvasWidgetB).

\begin{code}
module Widget where
import FranCore
import Identify
import WH
import ListB
import PrimWidget
import HasInput
import Conf
import GUIDef
\end{code}

A generic widget is an abstract data type. 
It may be:
a simple widget (GWidgetB)
an empty widget (EmptyW)
have input listener (GrabInput)
be two widgets composed (Compose)
a dynamic pile of widgets (PileW)
a choice between two widgets (CondWUnopt b w1 w2) (when b display w1 else w2)
a switcher (SwitcherW w e) - display w initially, when a widget appears on e,
display it instead,
a style with config options to be applied to any intermediate objects
eg main use for Panels created in GWidgetB PW. Note NOT used by any other
objects in GWidgetB. Anything else receives the style via the Monad.
A bit icky but necessary ...

\begin{code}
data GWidgetB a = GWidgetB ! a
               | EmptyW
	       | GrabInput ! Action ! (Listener UserAction) ! (GWidgetB a)
               | Compose ! (GWidgetB a) ! (GWidgetB a)
               | PileW ! (APile (GWidgetB a))
               | CondWUnopt ! BoolB ! (GWidgetB a) ! (GWidgetB a)
             --  | SwitcherW ! (GWidgetB a) ! (Event (GWidgetB a)) not implemented yet
	       | WithStyle [Conf Style](GWidgetB a)
 deriving Show

instance IfBehavior (GWidgetB a) where
 ifB = CondWUnopt

instance Has_Input (GWidgetB a) where
 bindAction a l w = GrabInput a l w

emptyWidgetB :: GWidgetB a
emptyWidgetB = EmptyW

instance Show (Event a) where
 show e = "<Event>"
\end{code}

a dynamic pile of values.
it has an initial set captured through the IO action,
and an event that tells of updates to the pile.
updates cover insertion, deletion, moving in stacking order and resetting 
the pile.

We can convert a dynamic list (ListB) into a pile
\begin{code}
data APile a = APile {initPile :: ! (IO [(Ident,a)]),
		      alterPile :: ! (Event (PileOp a))
		     }
 
instance Show (APile a) where
 show p = "<APile>"

data PileOp a = InsertElt ! a ! Ident ! (PlacePos Ident)
              | DeleteElt ! Ident
              | MoveElt ! Ident ! (PlacePos Ident) 
              | ResetElts ! [(Ident,a)]
 deriving Show

toPile :: ListB (GWidgetB a) -> APile (GWidgetB a)
toPile (CollectionB e b) =  
  APile (fmap fromList $ (do t <- getFranTime;b `at` t))
       (e ==> toPileOp)

toPileOp :: ListOp a -> PileOp a
toPileOp (InsertList k v pos) = InsertElt v k pos
toPileOp (DeleteList k) = DeleteElt k
toPileOp (ResetList vs) = ResetElts $ fromList vs
toPileOp (MoveList x p) = MoveElt x p
\end{code}

A window widget, is a widget containing a primitive widget that is a 
window item.
\begin{code}
type WindowWidgetB = GWidgetB WW
data WW = forall w . (Bindable w, WindowItem w) => WW (PrimWidget w)

instance Show WW where
 show (WW w) = "<WW " ++ show (uniqueId w) ++ ">"
\end{code}

a basic widget is a widget containing a panel item.
It may contain new pack info (static or behavioral) or a new packing mode 
(above or beside)
\begin{code}

type WidgetB = GWidgetB PW
data PW = forall w . (Bindable w ,PanelItem w) => PW (PrimWidget w) 
        | WithPack [PackInfo] WidgetB
	| WithPackB (Behavior [PackInfo]) WidgetB
	| WithPackMode PackMode WidgetB

instance Show PW where
 show (PW w) = "<PW " ++ show (uniqueId w) ++ ">"
 show (WithPack ps w) = "(WithPack " ++ show ps ++ " (" ++ show w ++ "))"
 show (WithPackB ps w) = "(WithPackB " ++ " (" ++ show w ++ "))"
 show (WithPackMode pm w) = "(WithPackMode " ++ show pm ++ " (" ++ show w ++ "))"
\end{code}

a canvas widget is a widget containing canvas items. there is a current 
behavioral transformation. (see Transform2B.hs in Fran for more on transforms)

\begin{code}
type CanvasWidgetB = GWidgetB CW
data CW = forall w . (CanvasItem w,Bindable w) => CW w
        | Transform2W Transform2B CanvasWidgetB

instance Transformable2B CanvasWidgetB where
  t *% w = GWidgetB $ Transform2W t w
\end{code}

There is a generic class for packing widgets.
As can be seen, as well as providing simple above and beside combinators, 
the packable class also provides a range of other functions. Widgets can be 
made to fill extra space in the X, Y or in both X and Y, using fill and fillB.
Widgets can be made to expand to take up available space in their parent, 
using expand and expandB. Widgets can be anchored to a particular corner using
anchor and anchorB. Finally, widgets can be given internal or external 
padding with padI/padIB and pad/padB respectively.  

To understand the difference between expand and fill note the following. 
Consider the example function, beside a b. We will refer to the resulting 
widget as the parent of a and b. With every widget we can associate an 
inherited area a widget gets from its parent. The occupied area is actually 
used for displaying information, and is always a centered subarea of the 
inherited one. Initially, the occupied and inherited area, equal the minimal 
dimensions needed by the widget to display its information. After combination 
with some other widget, the occupied area of the parent is minimal again. If 
widget a is bigger than widget b, the inherited area of a will equal its 
occupied area, and the inherited area of b will equal the rest of the occupied 
area of the parent. The fill functions make a widget occupy its inherited area 
either horizontally or vertically. The expand function makes a widget claim 
from its parent all occupied area that is not inherited by one of the other 
children. (This is a Tcl thing, we'll see how generic it remains.)

\begin{code}
class Packable w where
 above,beside :: w -> w -> w
 expandB :: Behavior Bool -> w -> w
 fillB :: Behavior Fill -> w -> w
 expand :: Bool -> w -> w
 fill :: Fill -> w -> w
 pad :: Pad -> w -> w
 padB :: Behavior Pad -> w -> w
 padI :: Pad -> w -> w
 padIB :: Behavior Pad -> w -> w
 packAnchor :: Anchor -> w -> w
 packAnchorB :: Behavior Anchor -> w -> w
\end{code}

There are a number of infix combinators that build on these basic functions. These combinators apply the same layout function on both arguments. For example ~-~ places two widgets above each other and aligns them in length, <|> places them next to each other, aligned in height; + is just a compbination of | and -. Finally, * applies an expand operation on the right and left operand.

\begin{code}

(<>),(<->),(<|>),(<+>) :: Packable w => w -> w -> w
(~~),(~-~),(~|~),(~+~) :: Packable w => w -> w -> w

a <> b = a `beside` b 
a <-> b =  fillX a `beside` fillY b
a <|> b = fillY a `beside` fillY b
a <+> b = fillXY a `beside` fillXY b

a ~~ b = a `above` b
a ~-~ b = fillX a `above` fillX b
a ~|~ b = fillY a `above` fillY b
a ~+~ b = fillXY a `above` fillXY b 

fillX,fillY,fillXY,flexible :: Packable w => w -> w
fillX = fill FillX
fillY = fill FillY
fillXY = fill FillXY
flexible = expand True . fillXY
\end{code}

To pack a collection of widgets beside or above each other use the 
PackCollection class

\begin{code}
class PackCollection c w where
 nabove :: c w -> w
 nbeside :: c w -> w
\end{code}

A basic widget is an instance of the Packable and the PackCollection classes.

\begin{code}

instance Packable WidgetB where
 above w1 w2 = GWidgetB $ WithPackMode PackAbove $ Compose w1 w2
 beside w1 w2 = GWidgetB $ WithPackMode PackBeside $ Compose w1 w2
 fill f = GWidgetB . WithPack [PackFill f] 
 expand b = GWidgetB . WithPack [PackExpand b]
 expandB b = GWidgetB . WithPackB (lift1 (\b -> [PackExpand b]) b)
 fillB f = GWidgetB . WithPackB (lift1 (\f -> [PackFill f]) f)
 pad p = GWidgetB . WithPack [PackPad p]
 padI p = GWidgetB . WithPack [PackPadInternal p]
 padB p = GWidgetB . WithPackB (lift1 (\p -> [PackPad p]) p)
 padIB p = GWidgetB . WithPackB (lift1 (\p -> [PackPadInternal p]) p)
 packAnchor p = GWidgetB . WithPack [PackAnchor p]
 packAnchorB p = GWidgetB . WithPackB (lift1 (\p -> [PackAnchor p]) p)

naboveLst :: ListB WidgetB -> WidgetB
naboveLst ls = 
  GWidgetB $ WithPackMode PackAbove $ 
  PileW $ toPile ls
 
nbesideLst :: ListB WidgetB -> WidgetB
nbesideLst ls = 
  GWidgetB $ WithPackMode PackBeside $ 
  PileW $ toPile ls

instance PackCollection (CollectionB ListOp List) WidgetB where
 nabove = naboveLst
 nbeside = nbesideLst

instance PackCollection [] WidgetB where
 nabove xs = foldr above emptyWidgetB xs
 nbeside xs = foldr beside emptyWidgetB xs
\end{code}

coming soon - grid layout
begin{code}
gridItem :: Behavior [GridBagConstraint] -> Component -> GridItem

grid :: [[GridItem]] -> Component

type MatrixB a = CollectionB MatrixOp Matrix a

data MatrixOp a = InsertM Ident a (Int,Int)
                | DeleteM Ident
end{code}

We can place a widget over another using over. 
We can do this with canvas widgets.

\begin{code}
class Over w where
 over :: w -> w -> w

instance Over CanvasWidgetB where
 over = Compose
\end{code}

We can stack a collection of widgets using the pile class.

\begin{code}
class Pile c w where
 pile :: c w -> w
\end{code}

This can be done with canvas widgets and window widgets, using lists 
and dynamic lists. (Note that the order of the list does not affect
the stacking order of window widgets in this implementation.)

\begin{code}
instance Pile [] CanvasWidgetB where
 pile cs = foldr Compose EmptyW cs

instance Pile (CollectionB ListOp List) CanvasWidgetB where
 pile cs = PileW $ toPile cs

instance Pile [] WindowWidgetB where
 pile cs = foldr Compose EmptyW cs

instance Pile (CollectionB ListOp List) WindowWidgetB where
 pile cs = PileW $ toPile cs

\end{code}

Deprecated 

\begin{code}

emptyWidget = emptyWidgetB
type WindowWidget = WindowWidgetB
type Widget = WidgetB
type CanvasWidget = CanvasWidgetB

\end{code}