GUI.hs

-- |The GUI type and helper functions
module Graphics.UI.AF.WxForm.GUI
    ( -- *GUI type
      GUI (Single, SelfContained, Buttons)
    -- ** GUI construting function
    , containerGUI, singleGui
      
    -- *Layout
    , LayoutManager
    , layoutGuiAs, dualColumn, singleColumn, singleRow, reverseGuis
    , rootGui
    
    -- * WxHaskell's Layout type
    -- 
    -- |Note that WxHaskell's Layout type is different from this
    --  modules Layout type.
    , boxedLayout, unboxedLayout, labeledLayout, nonEditableLayout

    -- * Misc
    , module Graphics.UI.AF.General.PriLabel, Labeled(..), LabelGetter(..)
    )

where


import qualified Graphics.UI.WX as WX
import Graphics.UI.AF.General.PriLabel

import List (partition)
import Maybe

-- |Contains a GUI-component. Used by 'EC'.
data GUI = Single WX.Layout PriLabel                         -- ^A GUI with a single GUI-component. 
         | SelfContained (String -> IO WX.Layout) PriLabel   -- ^Here the GUI handles the header itself.
         | Many LayoutManager [GUI] PriLabel                 -- ^A GUI with sub-GUI-components.
         | Buttons WX.Layout                                 -- ^A list of buttons.

-- SelfContained needs the IO, as WxEnumeration needs it. We need to
-- wait with setting the label, until after creating the GUI data, but
-- enumeration needs to do `set enum [ text := ... ]`. We need to wait
-- with setting the label, as it may be changed by functions like
-- `humanizeLabel`.
--
-- For the other constructors it is not a problem, as the GUI itself
-- do not set the label. The label is set by other means by other
-- functions. E.g. see `labeledLayout`.

class Labeled a where
    updateLabel :: (PriLabel -> PriLabel) -> a -> a
    setLabel    :: PriLabel -> a -> a
    setLabel lbl = updateLabel (const lbl)

class LabelGetter a where
    -- |Returns the label of a 'GUI'
    guiLabel :: a -> PriLabel

instance LabelGetter GUI where
    guiLabel (Single _ lbl)        = lbl
    guiLabel (SelfContained _ lbl) = lbl
    guiLabel (Many _ _ lbl)        = lbl
    guiLabel _                     = defaultLabel ""

instance Labeled GUI where
    updateLabel f (Single lay lbl)        = (Single lay $ f lbl)
    updateLabel f (SelfContained lay lbl) = (SelfContained lay $ f lbl)
    updateLabel f (Many manager guis lbl) = (Many manager guis $ f lbl)
    updateLabel _ gui                     = gui

instance Labeled PriLabel where
    updateLabel f lbl = f lbl

buttonsLabel :: PriLabel
buttonsLabel = defaultLabel "Press buttons"

-- |Constructs a GUI using Single-constructor.
singleGui :: (WX.Widget w) => PriLabel -> w -> (WX.Layout -> WX.Layout) -> GUI
singleGui label guiElement toWidget
    = Single (toWidget $ WX.widget guiElement) label

-- |Constructs a GUI using Many-constructor.
containerGUI :: [GUI] -> PriLabel -> GUI
containerGUI guis label = Many singleColumn guis label


--------------------------------------------------------------------------------

-- |Used to layout GUIs. If a GUI contains multiple components, the
-- layout manager arranges these components. Also see 'singleRow' or
-- 'singleColumn'.
type LayoutManager = [(WX.Layout, Maybe String)] -> WX.Layout

{-
defaultLayout :: LayoutManager
defaultLayout [] = error "GUI.defaultLayout: Must have at least one member of the list."
defaultLayout layoutsAndLabels =
    singleColumn $ mergeButtons layoutsAndLabels where
        mergeButtons
-}

-- FIXME: Consider using caption in stead of WX.label below:
-- Puts one or more Layouts in a column, without any heading (label).
singleColumn :: LayoutManager
singleColumn [] = error "GUI.singleColumn: Must have at least one member of the list."
singleColumn layoutsAndLabels =
    let (withLabels, withoutLabels) = partitionWidgets layoutsAndLabels
        isEmpty xs = (length xs) == 0
    in WX.column 10 $
       (if isEmpty withLabels
           then []
           else [WX.grid 20 10 withLabels]
       )
       ++ withoutLabels

-- |Arranges all gui components (widgets) in a row.
singleRow :: LayoutManager
singleRow [] = error "GUI.singleRow: Must have at least one member of the list."
singleRow layoutsAndLabels =
{-
    let (withLabels, withoutLabels) = partitionWidgets layoutsAndLabels
    in WX.row 10 $
       (concat withLabels)
       ++ withoutLabels
-}
    let labelWidgets (lay, Just name) = [WX.label name, lay]
        labelWidgets (lay, _)         = [lay]
    in WX.row 10 $ concatMap labelWidgets layoutsAndLabels

reverseGuis :: LayoutManager -> LayoutManager
reverseGuis manager layoutsAndLabels =
    manager $ reverse layoutsAndLabels


partitionWidgets :: [(WX.Layout, Maybe String)] -> ([[WX.Layout]], [WX.Layout])
partitionWidgets layoutsAndLabels =
    let sortedWidgets = partition (isJust . snd) layoutsAndLabels
        withLabels = map (\(lay, name) -> (lay, fromJust name)) (fst sortedWidgets)
        withoutLabels = map fst (snd sortedWidgets)
    in (map (\(lay,name) -> [WX.label name, lay]) withLabels, withoutLabels)

-- |Arranges all gui components (widgets) in a column.
dualColumn :: LayoutManager
dualColumn []  = error "AutoForms.GUI.dualColumn: Must have at least one member of the list."
dualColumn [x] = singleColumn [x]
dualColumn xs =
    let halfLength = length xs `div` 2
    in WX.row 35 (map singleColumn [take halfLength xs, drop halfLength xs])

-- |Attach a new layout manager to a 'GUI'. Layout manager such as
--  'dualColumn' or 'singleRow' can be used.
layoutGuiAs :: LayoutManager -> GUI -> GUI
layoutGuiAs newManager (Many _ guis label) = Many newManager guis label
layoutGuiAs _ gui = gui

-- |Special handling of a GUI if it is the top-most GUI.
rootGui :: GUI -> GUI
rootGui gui@(Many manager guis label) =
    case last guis of
      Buttons buttons -> let newButtons = Buttons (WX.column 10 [ WX.hfill $ WX.hrule 1
                                                                , buttons
                                                                ])
                         in Many manager (init guis ++ [newButtons]) label
      _ -> gui
rootGui gui = gui

-----------------------------------------------------------------------------

-- |Return a WxHaskell Layout with no editable values. E.g. just a label.
nonEditableLayout :: IO (WX.Layout, String)
nonEditableLayout = return (WX.label "No editable values!", "No editable values!")

-- |Turns a GUI into a WxHaskell Layout and a string (the label). The
--  layout has no box around it.
unboxedLayout :: GUI -> IO (WX.Layout, String)
unboxedLayout (Single lay label) = return (lay, labelString label)
unboxedLayout (SelfContained lay label)
    = do lay' <- lay $ labelString label
         return (lay', labelString label)
unboxedLayout (Many layoutManager [Many _ guis _] label)
    = unboxedLayout $ Many layoutManager guis label -- FIXME: should we push manager and label downwards?
unboxedLayout (Many _ [gui] _)
    = unboxedLayout gui
unboxedLayout (Many layoutManager guis label)
    = do layoutsAndLabels <- mapM boxedLayout guis
         return (layoutManager layoutsAndLabels, labelString label)
unboxedLayout (Buttons lay) = return (lay, labelString buttonsLabel)

-- |Returns a WxHaskell Layout. If possible the WxHaskell Layout will
-- be construced with a WxHaskell label to the left of the 'GUI'-s
-- Layout.
labeledLayout :: GUI -> IO WX.Layout
labeledLayout (Single lay label) = return $ WX.row 5 [ WX.label (labelString label), lay ]
labeledLayout (SelfContained lay label)
    = do lay' <- lay $ labelString label
         return lay'
labeledLayout (Many layoutManager [Many _ guis _] label)
    = labeledLayout $ Many layoutManager guis label -- FIXME: should we push manager and label downwards?
                                                    -- or maybe just use the best one
labeledLayout (Many _ [gui] _)
    = labeledLayout gui
labeledLayout (Many layoutManager guis _)
    = do layoutsAndLabels <- mapM boxedLayout guis
         return (layoutManager layoutsAndLabels)
labeledLayout (Buttons lay) = return lay

-- |Turns a GUI into a, possibly boxed, Layout.
--  A label will only be returned if GUI is of type Single.
--  If GUI's not of type Single, the Layout will contain its own label.
boxedLayout :: GUI -> IO (WX.Layout, Maybe String)
boxedLayout (Single lay label) = return (lay, Just $ labelString label)
boxedLayout (SelfContained lay label)
    = do lay' <- lay $ labelString label
         return (lay', Nothing)
boxedLayout (Many layoutManager [Many _ guis _] label)
    = boxedLayout $ Many layoutManager guis label -- FIXME: should we push manager and label downwards?
boxedLayout (Many _ [gui] _)
    = boxedLayout gui
boxedLayout (Many layoutManager guis label)
    = do guis' <- mapM boxedLayout guis
         return (WX.boxed (labelString label) (layoutManager guis'), Nothing)
boxedLayout (Buttons lay) = return (lay, Nothing)