module Sifflet.UI.Frame
    (
     CanvFrame(..), FrameType(..)
    , argIoletCounter
    , atLeastSizeFrame
    , cfEvalReady
    , cfPointInHeader
    , cfPointInFooter
    , cfRoot
    , frameNewWithLayout
    , frameBodyBox
    , frameNodeAt
    , frameOffset
    , levelOrder
    , nodeCompoundFunction
    , pointIolet
    , resizeFrame
    , translateFrame
    , grTranslateFrameNodes
    )

where

import Data.Function
import Data.List

import Data.Graph.Inductive as G

import Sifflet.Data.Functoid
import Sifflet.Data.Geometry
import Sifflet.Data.Tree
import Sifflet.Data.TreeLayout
import Sifflet.Data.WGraph
import Sifflet.Language.Expr
import Sifflet.Util

-- ---------------------------------------------------------------------
-- CanvFrame operations
-- ---------------------------------------------------------------------


-- | A CanvFrame represents (indirectly, through cfRoot, and we
-- access to the graph which is provided by the VCanvas)
-- a "subgraph" such as the expression tree
-- of a function which is being edited or called.

data CanvFrame = CanvFrame {
      cfHeader :: TextBox       -- ^ top area of the frame
    , cfFooter :: TextBox       -- ^ bottom area
    , cfVarNames :: [String]    -- ^ variable (parameter) names
    , cfParent :: Maybe G.Node  -- ^ the node opened to make this frame
    , cfFrameNode :: G.Node     -- ^ this frame as a node in the graph;
                                --   also serves as the ID of the frame.
    , cfEnv :: Env              -- ^ environment for evaluation
    , cfBox :: BBox -- ^ box of the whole frame (header, tree, and footer)
    , cfLevel :: Double         -- ^ 0 = bottom level, 1 = next higher, etc.
    , cfFunctoid :: Functoid    -- ^ includes tlo for an edit frame
    , frameType :: FrameType    -- ^ edit or call frame
    }
                 deriving (Show)
                 


-- | CanvFrame needs to be Eq in order to be Ord,
-- but maybe the Eq and Ord definitions should be more
-- in the same spirit?
instance Eq CanvFrame where (==) = (==) `on` cfFrameNode

data FrameType = EditFrame | CallFrame deriving (Eq, Read, Show)

-- | Use levelOrder for sorting frames before drawing them
levelOrder :: CanvFrame -> CanvFrame -> Ordering
levelOrder f1 f2 = compare (cfLevel f1) (cfLevel f2) 

-- | The root of the tree displayed in the frame
cfRoot :: CanvFrame -> G.Node
cfRoot frame = 
    case frameType frame of
      EditFrame -> error "cfRoot: an edit frame has no root"
      CallFrame -> succ (cfFrameNode frame)

-- | A frame is "eval ready" -- that is, okay to run the Eval Frame dialog --
-- if it is a call frame with no parent
cfEvalReady :: CanvFrame -> Bool
cfEvalReady frame = 
    (frameType frame == CallFrame) && (cfParent frame == Nothing)

cfPointInHeader :: CanvFrame -> Double -> Double -> Bool
cfPointInHeader frame x y = 
    pointInBB (Position x y) (tbBoxBB (cfHeader frame))

cfPointInFooter :: CanvFrame -> Double -> Double -> Bool
cfPointInFooter frame x y = 
    pointInBB (Position x y) (tbBoxBB (cfFooter frame))

frameBodyBox :: CanvFrame -> BBox
frameBodyBox frame =
    -- the space between the header and footer
    let hbb = tbBoxBB (cfHeader frame)
        fbb = tbBoxBB (cfFooter frame)
        top = bbBottom hbb
        bottom = bbTop fbb
    -- assuming both header and footer are left aligned and same width
    in BBox (bbLeft hbb) top (bbWidth hbb) (bottom - top)

editFrameNodes :: CanvFrame -> [G.Node]
editFrameNodes frame =
    case frameType frame of
      EditFrame -> fpNodes (cfFunctoid frame)
      CallFrame -> error "editFrameNodes: not an EditFrame"

frameNodeAt :: CanvFrame -> WGraph -> Position -> Maybe G.Node
frameNodeAt frame graph point = 
    case frameType frame of
      CallFrame -> callFrameNodeAt frame graph point
      EditFrame -> editFrameNodeAt frame graph point

editFrameNodeAt  :: CanvFrame -> WGraph -> Position -> Maybe G.Node
editFrameNodeAt _frame _graph _point = Nothing -- STUB ***
  -- this could probably make use of the function that finds ***
  -- a selection from a point ***

callFrameNodeAt :: CanvFrame -> WGraph -> Position -> Maybe G.Node
callFrameNodeAt frame graph point = 
    let search :: [G.Node] -> Maybe G.Node
        search [] = Nothing
        search (r:rs) =
            case lab graph r of
              Just (WFrame _) -> search rs
              Just (WSimple layoutNode) ->
                  let LayoutNode rootGNode treeBB = layoutNode
                  in
                    if pointInBB point treeBB 
                    -- it's in the tree rooted at r
                    then if pointInBB point (gnodeNodeBB rootGNode) 
                         -- it's in the root node
                         then Just r
                         else search (suc graph r) -- maybe in the subtrees
                    else search rs                 -- maybe in the siblings
              Nothing -> 
                  errcats ["editFrameNodeAt: search: no label for node",
                           show r]
    -- since this is a call frame, it had better have a root
    in search [cfRoot frame]

atLeastSizeFrame :: Size -> CanvFrame -> CanvFrame
atLeastSizeFrame (Size minW minH) frame =
    let BBox _ _ width height = cfBox frame
        dwidth = if minW > width then minW - width else 0
        dheight = if minH > height then minH - height else 0
    in resizeFrame frame dwidth dheight

resizeFrame :: CanvFrame -> Double -> Double -> CanvFrame
resizeFrame frame dw dh = 
    let BBox x y bwidth height = frameBodyBox frame
        -- do not shrink body to negative size
        bwidth' = max 0 (bwidth + dw)
        height' = max 0 (height + dh)
        bodyBB' = BBox x y bwidth' height'
        header' = alignHeader (cfHeader frame) bodyBB'
        footer' = alignFooter (cfFooter frame) bodyBB'
        frameBox' = bbMergeList [tbBoxBB header', tbBoxBB footer', bodyBB']
    in frame {cfHeader = header', cfFooter = footer', cfBox = frameBox'}


translateFrame :: CanvFrame -> Double -> Double -> CanvFrame
translateFrame frame dx dy =
    frame {cfHeader = translate dx dy (cfHeader frame),
           cfFooter = translate dx dy (cfFooter frame),
           cfBox = translate dx dy (cfBox frame)}


-- | Where to position a new frame that is grown out of an old frame?
-- This is a very rough draft of frameOffset
frameOffset :: Style -> CanvFrame -> Position
frameOffset style oldFrame = 
    let bb = cfBox oldFrame
    in Position (bbRight bb + styleFramePad style) (bbTop bb - 40)



nodeCompoundFunction :: WGraph -> CanvFrame -> Node -> Maybe Function
nodeCompoundFunction graph frame node = 
    case lab graph node of
      Nothing -> error "nodeCompoundFunction: no label for node"
      Just (WFrame _) -> error "nodeCompoundFunction: node has a WFrame label"
      Just (WSimple layoutNode) ->
          case gnodeValue (nodeGNode layoutNode) of
            ENode (NSymbol (Symbol "if")) _mvalue -> Nothing -- not a function
            ENode (NSymbol (Symbol symbolName)) _mvalue ->
                case envLookup (cfEnv frame) symbolName of
                  Nothing -> Nothing -- unbound symbol okay, at least sometimes
                  Just (VFun func@(Function _ _ _ (Compound _ _))) -> Just func
                  Just _ -> Nothing -- not a compound function
            _ -> Nothing -- not a symbol

grTranslateFrameNodes :: WGraph -> CanvFrame -> Double -> Double -> WGraph
grTranslateFrameNodes wgraph frame dx dy =
    case frameType frame of
      CallFrame -> translateTree dx dy wgraph (cfRoot frame)
      EditFrame -> translateNodes dx dy wgraph (editFrameNodes frame)
      
pointIolet :: Position -> Int -> [Iolet] -> Maybe Int
pointIolet point n iolets =
    -- find the number of the iolet, if any, containing point
    case iolets of 
      [] -> Nothing
      (p:ps) ->
          if pointInIolet point p 
          then Just n
          else pointIolet point (n + 1) ps


-- | argIoletCounter returns (no. of inlets, no. of outlets)
-- derived from the argument list of a function still being defined
argIoletCounter :: [String] -> ExprNode -> (Int, Int)
argIoletCounter labels _exprNode = (length labels, 1)

-- | Aligning a CanvFrame's header and footer with the body of the frame.
-- Aligns the header above, and the footer below, the body of the frame,
-- also matching the width if the body widened

alignHeader :: TextBox -> BBox -> TextBox
alignHeader header bodybox =
    let headerBB = tbBoxBB header
        y0 = bbBottom headerBB
        y1 = bbTop bodybox
        x0 = bbLeft headerBB
        x1 = bbLeft bodybox
    in translate (x1 - x0) (y1 - y0) (tbSetWidth header (bbWidth bodybox))

alignFooter :: TextBox -> BBox -> TextBox
alignFooter footer bodybox =
    let footerBB = tbBoxBB footer
        y0 = bbTop footerBB
        y1 = bbBottom bodybox
        x0 = bbLeft footerBB
        x1 = bbLeft bodybox
    in translate (x1 - x0) (y1 - y0) (tbSetWidth footer (bbWidth bodybox))


-- | Figure out the frame layout for a function.  Returns the layout and frame.
-- Currently, the frame is marked as a "call frame"; if you want to edit it,
-- call (editFrame? editFunction?)

frameNewWithLayout :: Style -> Position -> Double
                   -> Functoid -> Maybe [Value] -> FrameType -- added arg
                   -> Node -> Env -> Maybe G.Node 
                   -> (CanvFrame, FunctoidLayout) -- reversed tuple
frameNewWithLayout style (Position x y) z 
                   functoid mvalues mode frameNode prevEnv mparent = 
  -- Figure out the positions for a function call with the
  -- given function and (possibly) values as arguments
  let headerText = functoidHeader functoid
      vars = functoidArgNames functoid
      footerText = buildFooterText vars mvalues
      env = case mvalues of
              Nothing ->
                  -- dummy extension to be popped off
                  extendEnv [] [] prevEnv 
              Just values ->
                  extendEnv vars values prevEnv
      -- body tlo
      layout0 = flayout style functoid env mvalues
      -- header and footer layouts
      headerTB0 = makeTextBox style headerText -- at 0 0
      footerTB0 = makeTextBox style footerText -- at 0 0

      -- make all three the same width
      Size lw lh = flayoutSize layout0
      fwidth = maximum [tbWidth headerTB0, lw, tbWidth footerTB0]
      -- The __widen functions ensure that each part 
      -- (header, footer, tree tlo) have the desired width.
      headerTB1 = translate x y (widen headerTB0 fwidth)
      (dx, dy) = (x - hpad style, tbBottom headerTB1 - vpad style)
      layout1 = translate dx dy (flayoutWiden layout0 fwidth)
      footerTB1 = translate x (flayoutBottom layout1) 
                  (widen footerTB0 fwidth)
      frameBox = BBox x y fwidth 
                 (tbHeight headerTB0 + lh + tbHeight footerTB0)
      frame = CanvFrame {cfHeader = headerTB1,
                         cfFooter = footerTB1,
                         cfVarNames = vars,
                         cfParent = mparent,
                         cfFrameNode = frameNode,
                         cfEnv = env, 
                         cfBox = frameBox,
                         cfLevel = z,
                         cfFunctoid = functoid,
                         frameType = mode}
  in (frame, layout1)



buildFooterText :: [String] -> Maybe [Value] -> String
buildFooterText vars mvalues = 
    let items =
            case mvalues of
              Nothing -> vars
              Just [] -> vars
              Just values ->
                  if length vars /= length values
                  then error "buildFooterText: mismatched lists"
                  else [var ++ " = " ++ repr value |
                        (var, value) <- zip vars values]
    in concat (intersperse ", " items)