Types.hs

module Sifflet.UI.Types 
    (VPUI(..)
    , WinId, VPUIWindow(..)
    , vpuiFileChanged
    , vpuiUserEnvAList

    -- | Operations on a VPUI involving its window
    , vpuiInsertWindow
    , vpuiTryGetWindow
    , vpuiGetWindow
    , vpuiUpdateWindow
    , vpuiReplaceWindow
    , vpuiUpdateWindowIO
    , vpuiRemoveVPUIWindow

    -- | Operations on a window involving its canvas
    , vpuiWindowLookupCanvas, vpuiWindowGetCanvas
    , vpuiWindowSetCanvas, vpuiWindowModCanvas 
    , vpuiWindowModCanvasIO

    -- | Operation on a VPUI involving the canvas of its window
    , vpuiModCanvas, vpuiModCanvasIO
                   
    -- | Other operations on a window
    , vpuiWindowWindow

    , VPToolkit(..)

    , Toolbox(..)
    , Tool(..)
    , ToolContext(..)

    , CanvasToolOp
    , ToolOp
    , toToolOpVW 

    , Workspace(..)
    , FunctionEditor(..)
    , fedFunctionName
    , VCanvas(..)
    , Selection(..)
    , Dragging(..)
    )

where

import Data.Map as Map 
import Data.Graph.Inductive as G

import Graphics.UI.Gtk.Gdk.EventM (Modifier(..))

import Sifflet.Data.Geometry
import Sifflet.Data.TreeLayout
import Sifflet.Data.WGraph
import Sifflet.Language.Expr

import Sifflet.UI.Frame
import Sifflet.UI.LittleGtk
import Sifflet.UI.RPanel
import Sifflet.Util


-- | VPUI: Sifflet (formerly VisiProg) User Interface
-- The initialEnv is apt to contain "builtin" functions;
-- it's preserved here so that when writing to a file,
-- we can skip the functions that were in the initial env.
data VPUI = VPUI {
      vpuiWindows :: Map WinId VPUIWindow,  -- ^ all the windows of the program
      vpuiToolkits :: [(String, VPToolkit)], -- ^ ordered association list,
                                             -- collections of tools
      vpuiFilePath :: Maybe FilePath,       -- ^ the file opened or to save
      vpuiStyle :: Style,              -- ^ for windows, canvases, editors
      vpuiInitialEnv :: Env,           -- ^ initial value of global environment
      vpuiGlobalEnv :: Env,   -- ^ the global environment
      vpuiFileEnv :: Env      -- ^ global env as of last file open or save,
                              -- used to detect unsaved changes
    }

-- | Tell whether the global environmkent has changed since the
-- last file open or save
vpuiFileChanged :: VPUI -> Bool
vpuiFileChanged vpui = vpuiGlobalEnv vpui /= vpuiFileEnv vpui

-- | Extract from the environment the part defined by the user
-- But you probably want to use Sifflet.UI.Window.UserFunctions
-- instead of this.
vpuiUserEnvAList :: VPUI -> [(String, Value)]
vpuiUserEnvAList vpui =
    let env' = vpuiGlobalEnv vpui -- I hope
        env = vpuiInitialEnv vpui
    in if length env == 1 && length env' == 1
       then assocs (Map.difference (head env') (head env))
       else errcats ["vpuiUserEnv: env lengths are not one",
                   "|env'|:", show (length env'),
                   "|env|:", show (length env)]

-- | Insert a window in the window map
vpuiInsertWindow :: VPUI -> WinId -> VPUIWindow -> VPUI
vpuiInsertWindow vpui winId vw =
    vpui {vpuiWindows = Map.insert winId vw (vpuiWindows vpui)}

-- | Try to get the VPUIWindow with the given window ID,
-- return Just result or Nothing
vpuiTryGetWindow :: VPUI -> WinId -> Maybe VPUIWindow
vpuiTryGetWindow vpui winId = Map.lookup winId (vpuiWindows vpui)

-- | Get the VPUIWindow with the given window ID;
-- it is an error if this fails.
vpuiGetWindow :: VPUI -> WinId -> VPUIWindow
vpuiGetWindow vpui winId = vpuiWindows vpui ! winId

-- | Replace a VPUIWindow with given window ID;
-- it is an error if this fails.
vpuiReplaceWindow :: VPUI -> WinId -> VPUIWindow -> VPUI
vpuiReplaceWindow vpui winId vpuiWin =
    let winMap = vpuiWindows vpui
        winMap' = insert winId vpuiWin winMap
    in vpui {vpuiWindows = winMap'}

-- | Apply an update function to a VPUIWindow with given window ID;
-- it is an error if this fails.
vpuiUpdateWindow :: VPUI -> WinId -> (VPUIWindow -> VPUIWindow) -> VPUI
vpuiUpdateWindow vpui winId updater =
    let winMap = vpuiWindows vpui
        winMap' = adjust updater winId winMap
    in vpui {vpuiWindows = winMap'}

-- | Apply an update IO action to a VPUIWindow with given window ID;
-- it is an error if this fails.
vpuiUpdateWindowIO :: WinId -> (VPUIWindow -> IO VPUIWindow) -> VPUI -> IO VPUI
vpuiUpdateWindowIO winId updater vpui = do
  {
    let winMap = vpuiWindows vpui
        vw = winMap ! winId
  ; vw' <- updater vw
  ; let winMap' = insert winId vw' winMap
  ; return $ vpui {vpuiWindows = winMap'}
  }

-- | Remove a window from the windows map; it has already been destroyed
-- in the GUI
vpuiRemoveVPUIWindow :: WinId -> VPUI -> VPUI
vpuiRemoveVPUIWindow winId vpui =
    let winMap = vpuiWindows vpui
        winMap' = delete winId winMap
    in vpui {vpuiWindows = winMap'}

data VPUIWindow = -- VPUIJustWindow Window 
                  VPUIWorkWin Workspace Window
                | FunctionPadWindow Window [(String, RPanel)]


vpuiWindowWindow :: VPUIWindow -> Window
vpuiWindowWindow vw =
    case vw of
      VPUIWorkWin _ w -> w
      FunctionPadWindow w _ -> w

-- | Try to find canvas; fail gracefully
vpuiWindowLookupCanvas :: VPUIWindow -> Maybe VCanvas
vpuiWindowLookupCanvas vw =
    case vw of
      VPUIWorkWin ws _ -> Just (wsCanvas ws)
      _ -> Nothing

-- | Find canvas or fail dramatically
vpuiWindowGetCanvas :: VPUIWindow -> VCanvas
vpuiWindowGetCanvas vw =
    case vpuiWindowLookupCanvas vw of
      Nothing -> error "vpuiWindowGetCanvas: no canvas found"
      Just canvas -> canvas

vpuiWindowSetCanvas :: VPUIWindow -> VCanvas -> VPUIWindow
vpuiWindowSetCanvas vw canvas =
    case vw of
      VPUIWorkWin ws w -> VPUIWorkWin (ws {wsCanvas = canvas}) w
      _ -> error "vpuiWindowSetCanvas: not a workspace window"

vpuiWindowModCanvas :: VPUIWindow -> (VCanvas -> VCanvas) -> VPUIWindow
vpuiWindowModCanvas vw f =
    case vpuiWindowLookupCanvas vw of
      Nothing -> error "vpuiWindowModCanvas: plain VPUIWindow"
      Just canvas -> vpuiWindowSetCanvas vw (f canvas)

vpuiWindowModCanvasIO :: VPUIWindow -> (VCanvas -> IO VCanvas) -> IO VPUIWindow
vpuiWindowModCanvasIO vw f =
    case vpuiWindowLookupCanvas vw of
      Nothing -> error "vpuiWindowModCanvas: plain VPUIWindow"
      Just canvas -> 
          do
            { 
              canvas' <- f canvas
            ; return $ vpuiWindowSetCanvas vw canvas'
            }

-- | Update the canvas of the specified window, without IO
vpuiModCanvas :: VPUI -> WinId -> (VCanvas -> VCanvas) -> VPUI
vpuiModCanvas vpui winId modCanvas = 
    let modWindow vw = vpuiWindowModCanvas vw modCanvas
    in vpuiUpdateWindow vpui winId modWindow

-- | Update the canvas of the specified window, with IO
vpuiModCanvasIO :: VPUI -> WinId -> (VCanvas -> IO VCanvas) -> IO VPUI
vpuiModCanvasIO vpui winId modCanvas = 
    let modWindow vw = vpuiWindowModCanvasIO vw modCanvas
    in vpuiUpdateWindowIO winId modWindow vpui

type WinId = String

data Workspace = Workspace {wsBox :: VBox, -- ^ container of the rest
                            wsCanvas :: VCanvas, -- ^ the canvas
                            wsButtonBar :: HBox,
                            wsStatusbar :: Statusbar}

data FunctionEditor = FunctionEditor {fedWindow :: Window,
                                      fedWinTitle :: String,
                                      fedFunction :: Function,
                                      fedCanvas :: VCanvas
                                      -- , fedUIRef :: IORef VPUI
                                     }

fedFunctionName :: FunctionEditor -> String
fedFunctionName = functionName . fedFunction

-- | Toolkit functions are organized in groups (rows) for presentation
-- in a toolbox
data VPToolkit = VPToolkit {toolkitName :: String,
                            toolkitWidth :: Int, -- (-1) = don't care
                            toolkitRows :: [[Tool]]}

-- | A Toolbox is a framed VBox with a set of Toolbars attached
data Toolbox = Toolbox {toolboxFrame :: GtkFrame
                       , toolboxVBox :: VBox}

-- | ToolOp a is intended for a = VPUIWindow or VCanvas
-- type ToolOp a 
--   = VPUI -> a -> ToolContext -> [Modifier] -> Double -> Double -> IO a

type ToolOp 
  = VPUI -> WinId -> ToolContext -> [Modifier] -> Double -> Double -> IO VPUI

type CanvasToolOp
  = VCanvas -> ToolContext -> [Modifier] -> Double -> Double -> IO VCanvas

data Tool = Tool {toolName :: String, -- the tool's name

                  -- what to do when the tool is selected from the toolbox
                  toolActivated :: VCanvas -> IO VCanvas,

                  -- what to do to apply the tool to a point on the canvas
                  toolOp :: ToolOp
                 }

-- | A helper for making toolOps from actions on VCanvas

toToolOpVW :: CanvasToolOp -> ToolOp
toToolOpVW vcOp vpui winId toolContext mods x y = do
  {
    let vw = vpuiGetWindow vpui winId
        canv = vpuiWindowGetCanvas vw
  ; canv' <- vcOp canv toolContext mods x y
  ; let vw' = vpuiWindowSetCanvas vw canv'
  ; return $ vpuiReplaceWindow vpui winId vw'
  }
    
-- | ToolContext: The way a tool should be applied depends on 
-- where it is being used 

data ToolContext = TCWorkspace 
                 | TCCallFrame CanvFrame 
                 | TCEditFrame CanvFrame
                 | TCExprNode -- ???



-- | A canvas that can display multiple boxes representing 
-- expressions or function definitions or calls

data VCanvas = VCanvas {
      vcLayout :: GtkLayout,
      vcStyle :: Style,
      vcGraph :: WGraph,
      vcFrames :: [CanvFrame],
      vcSize :: Size,
      -- vcLocalEnv :: Env,  -- only good for function editor, I think? 
      vcMousePos :: (Double, Double),
      vcTool :: Maybe Tool,     -- current tool on this canvas
      vcActive :: Maybe Node,   -- active node, if any
      vcSelected :: Maybe Selection, -- selected node(s), if any
      vcDragging :: Maybe Dragging -- what we're dragging, if anything
    }


data Selection = SelectionNode {selNode :: G.Node}
               | SelectionInlet {selNode :: G.Node,
                                 selInEdge :: WEdge} -- numbered from 0
               | SelectionOutlet {selNode :: G.Node,
                                 selOutEdge :: WEdge} -- normally just 0
                 deriving (Eq, Read, Show)

-- | A Dragging keeps track of the object (node) being dragged
-- and the current mouse position.

data Dragging = Dragging { draggingNode :: G.Node,
                           draggingPosition :: Position
                           }
               deriving (Eq, Read, Show)