{-# LANGUAGE FlexibleContexts, RankNTypes #-}
{-# OPTIONS -Wall #-}

{- | Handles joining of many 'Graphics.UI.WX.Layout' into one
   'Graphics.UI.WX.Layout'.
-}
module Graphics.UI.WxGeneric.Layout
    ( smartLayout, oneColumnLayout, twoColumnLayout
    , JoinLayout, SizedLayout
    , toSizedLayout
    )
where

import Graphics.UI.WX
import Data.List

smartMaxHorizontalSize :: Int
smartMaxHorizontalSize = 400

-- |Used for debug. See 'toHeader'.
showWidgetSizeInHeadings :: Bool
showWidgetSizeInHeadings = False

type JoinLayout        = String -> FromWxGenLayout Layout
type SizedLayout       = (Int, Layout)
type FromWxGenLayout a = [(StaticText (), SizedLayout)] -> [SizedLayout] -> a
type WxGenLayout       = ([(StaticText (), SizedLayout)], [SizedLayout])

estimateSize :: Dimensions w => w -> IO Int
estimateSize w = get w bestSize >>= return . sizeH

toSizedLayout :: (Widget w, Dimensions w) => w -> IO SizedLayout
toSizedLayout wid = do s <- estimateSize wid
                       return (s, widget wid)
            
smartLayout :: JoinLayout
smartLayout topHeading withLabels withoutLabels
    | sum (sizes withLabels withoutLabels) > smartMaxHorizontalSize
        = twoColumnLayout topHeading withLabels withoutLabels
    | otherwise
        = oneColumnLayout topHeading withLabels withoutLabels

-- |Normally, just copies the header. But for debug purposes 'showWidgetSizeInHeadings'
-- can be set to True.
toHeader :: String -> FromWxGenLayout String
toHeader header withLabels withoutLabels =
    case showWidgetSizeInHeadings of
      False -> header
      True  -> header ++ ", sizes=" ++ (show $ sizes withLabels withoutLabels)

sizes :: FromWxGenLayout [Int]
sizes withLabels withoutLabels
    = map fst (map snd withLabels ++ withoutLabels)

oneColumnLayout :: JoinLayout
oneColumnLayout topHeading withLabels withoutLabels =
    if (null withLabels && null withoutLabels)
       then fill $ boxed "" $ label "no contents"
       else let h = toHeader topHeading withLabels withoutLabels
            in boxed h $ layoutColumn withLabels withoutLabels

-- |Makes a layout in two columns. If there is less than two Layout's
-- to join, it will diverge to 'oneColumnLayout'.
twoColumnLayout :: JoinLayout
twoColumnLayout topHeading withLabels withoutLabels
    = case splitMiddle withLabels withoutLabels of
        (_, ([], [])) -> divergeOneColumn
        (([], []), _) -> divergeOneColumn
        (leftLay, rightLay)
            -> let columnLayout lay = column 1 [ uncurry layoutColumn lay, glue ]
                   h = toHeader topHeading withLabels withoutLabels
               in boxed h $ row 10 [ columnLayout leftLay
                                   , columnLayout rightLay ]
      where divergeOneColumn = oneColumnLayout topHeading withLabels withoutLabels

splitMiddle :: FromWxGenLayout (WxGenLayout, WxGenLayout)
splitMiddle labeled unlabeled =
    let xs             = sizes labeled unlabeled
        middlePixel    = sum xs `div` 2
        middle         = length $ takeWhile (< middlePixel) $ map sum $ tail $ inits xs
        splitLabeled   = splitAt middle labeled
        splitUnlabeled = splitAt (middle - length labeled) unlabeled
    in ((fst splitLabeled, fst splitUnlabeled)
       ,(snd splitLabeled, snd splitUnlabeled))

layoutColumn :: FromWxGenLayout Layout
layoutColumn withLabels withoutLabels
    = column 10 $
      (if null withLabels
          then []
          else [grid 20 10 $ map toLayout withLabels ]
      ) ++ map snd withoutLabels
    where
      toLayout (lbl, (s, w)) =
          case showWidgetSizeInHeadings of
            True  -> [alignLeft $ widget lbl, label $ show s, w]
            False -> [alignLeft $ widget lbl, w]