sifflet-0.1.5: UITypes.hs

module UITypes (VPUI(..)
               , WinId, VPUIWindow(..)
               , 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 
    hiding (Function, Layout, Style, Size)
import qualified Graphics.UI.Gtk as Gtk (Frame, Layout)
import Graphics.UI.Gtk.Gdk.EventM (Modifier(..))

import RPanel
import TreeLayout
import Workspace.Frame
import Workspace.WGraph
import Expr
import Geometry

-- | 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,
      vpuiToolkits :: Map String VPToolkit, -- collections of tools
      -- A phantom button (never shown) to represent the group of all tools:
      vpuiButtonGroup :: RadioToolButton,
      vpuiFilePath :: Maybe FilePath, -- the file opened or to save
      vpuiFileChanged :: Bool,         -- has file changed since open/save?
      vpuiStyle :: Style,              -- for windows, canvases, editors
      vpuiInitialEnv :: Env,           -- initial value of global environment
      vpuiGlobalEnv :: Env             -- the global environment
    }

-- | Extract from the environment the part defined by the user
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 error ("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 :: Gtk.Frame
                       , 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 :: Gtk.Layout,
      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)