-- | If the items in the UIState module are the only state you need in your
--   program, then it is sufficient to import this module and start with the
--   defaultBasicState.
--
--   [@Author@] Jeff Heard
--
--   [@Copyright@] © 2008 Renaissance Computing Institute
--
module Graphics.Rendering.Hieroglyph.Scaffolds.Interactive where

import Graphics.Rendering.Hieroglyph.Primitives
import Graphics.Rendering.Hieroglyph.ImageCache
import Graphics.Rendering.Hieroglyph.Visual
import qualified Graphics.UI.Gtk as Gtk
import Control.Concurrent 
import Data.Map (Map,empty)
import System.Mem.Weak


-- | A keystroke
data Key =
      Character Char
    | Enter 
    | Tab 
    | BackSpace
    | Insert 
    | Delete
    | Home 
    | End 
    | PgUp 
    | PgDown
    | PF1 | PF2 | PF3 | PF4 | PF5 | PF6 | PF7 | PF8 | PF9 | PF10 | PF11 | PF12

-- | All that you need to provide interactivity
data Scaffolding = Scaffolding  
    { mousePosition :: Point
    , mouseLeftButtonDown :: Bool
    , mouseRightButtonDown :: Bool
    , mouseMiddleButtonDown :: Bool
    , mouseWheel :: Int
    , keyCtrl :: Bool
    , keyShift :: Bool
    , keyAlt :: Bool
    , key :: Key 
    , drawing :: Maybe Gtk.Widget 
    , sizeX :: Double
    , sizeY :: Double 
    , imageCache :: Maybe ImageCache }
    
instance Interactive Scaffolding where
    getInteractiveScaffolding = id
    setInteractiveScaffolding a b = b
    interactionFold a b = a    

-- | Implement this class to make your application interactive
class Interactive a where
    getInteractiveScaffolding :: a -> Scaffolding	-- ^ get the interactive Scaffolding record from your data
    setInteractiveScaffolding :: a -> Scaffolding -> a  -- ^ set the Interactive Scaffolding record in your data    
    -- | Interaction can be thought of as a foldr on an infinite list of data.
    --   The intent of implementing this function is that the implementer will
    --   fold the given event data (in the Scaffolding instance) with the data
    --   being visualized and the geometry that goes with the event data to 
    --   produce a new set of data to visualize.
    interactionFold :: a -> [Primitive] -> a 
    
-- | The initial Scaffolding record.  Start with this.
scaffold :: Scaffolding 
scaffold = Scaffolding (Point 0 0) False False False 0 False False False (Character '\0') Nothing 800 600 Nothing

-- | Get the mouse position in window coordinates
getMousePosition :: Interactive a => a -> Point
getMousePosition = mousePosition . getInteractiveScaffolding

-- | Get the left button state
getMouseLeftButtonDown :: Interactive a => a -> Bool
getMouseLeftButtonDown = mouseLeftButtonDown . getInteractiveScaffolding

-- | Get the right button state
getMouseRightButtonDown :: Interactive a => a -> Bool
getMouseRightButtonDown = mouseRightButtonDown . getInteractiveScaffolding

-- | Get the middle button state
getMouseMiddleButtonDown :: Interactive a => a -> Bool
getMouseMiddleButtonDown = mouseMiddleButtonDown . getInteractiveScaffolding

-- | Get the number of clicks up or down the mouse button has gone
getMouseWheel :: Interactive a => a -> Int
getMouseWheel = mouseWheel . getInteractiveScaffolding

-- | Get the ctrl modifier state
getKeyCtrl :: Interactive a => a -> Bool
getKeyCtrl = keyCtrl . getInteractiveScaffolding

-- | Get the shift modifier state
getKeyShift :: Interactive a => a -> Bool
getKeyShift = keyShift . getInteractiveScaffolding

-- | Get the shift modifier state
getKeyAlt :: Interactive a => a -> Bool
getKeyAlt = keyAlt . getInteractiveScaffolding

-- | Get the key that was pressed
getKey :: Interactive a => a -> Key
getKey = key . getInteractiveScaffolding

-- | Get the drawing window.  Not usually needed by the user, as there's not much you can do with it.
getDrawing :: Interactive a => a -> Maybe Gtk.Widget 
getDrawing = drawing . getInteractiveScaffolding

-- | Get the width of the drawing window
getSizeX :: Interactive a => a -> Double
getSizeX = sizeX . getInteractiveScaffolding

-- | Get the height of the drawing window
getSizeY :: Interactive a => a -> Double 
getSizeY = sizeY . getInteractiveScaffolding

-- | Get the image cache
getImageCache :: Interactive a => a -> Maybe ImageCache
getImageCache = imageCache . getInteractiveScaffolding

setMousePosition :: Interactive a => Point -> a -> a
setMousePosition p v = setInteractiveScaffolding v s' 
    where s = getInteractiveScaffolding v
          s' = s{ mousePosition = p }  
          
setMouseLeftButtonDown :: Interactive a => Bool -> a -> a
setMouseLeftButtonDown p v = setInteractiveScaffolding v s'
    where s = getInteractiveScaffolding v
          s' = s{ mouseLeftButtonDown = p }

setMouseRightButtonDown :: Interactive a => Bool -> a -> a
setMouseRightButtonDown p v = setInteractiveScaffolding v s'
    where s = getInteractiveScaffolding v
          s' = s{ mouseRightButtonDown = p }
          
setMouseMiddleButtonDown :: Interactive a => Bool -> a -> a
setMouseMiddleButtonDown p v = setInteractiveScaffolding v s'
    where s = getInteractiveScaffolding v
          s' = s{ mouseMiddleButtonDown = p }
          
setMouseWheel :: Interactive a => Int -> a -> a
setMouseWheel p v = setInteractiveScaffolding v s'
    where s = getInteractiveScaffolding v
          s' = s{ mouseWheel = p }

setKeyCtrl :: Interactive a => Bool -> a -> a
setKeyCtrl p v = setInteractiveScaffolding v s'
    where s = getInteractiveScaffolding v
          s' = s{ keyCtrl = p }
          
setKeyShift :: Interactive a => Bool -> a -> a
setKeyShift p v = setInteractiveScaffolding v s'
    where s = getInteractiveScaffolding v
          s' = s{ keyShift = p }
          
setKeyAlt :: Interactive a => Bool -> a -> a
setKeyAlt p v = setInteractiveScaffolding v s'
    where s = getInteractiveScaffolding v
          s' = s{ keyAlt = p }

setKey :: Interactive a => Key -> a -> a
setKey p v = setInteractiveScaffolding v s'
    where s = getInteractiveScaffolding v
          s' = s{ key = p }
          
setDrawing :: Interactive a => Maybe Gtk.Widget -> a -> a
setDrawing p v = setInteractiveScaffolding v s'
    where s = getInteractiveScaffolding v
          s' = s{ drawing = p }

setSizeX :: Interactive a => Double -> a -> a
setSizeX p v = setInteractiveScaffolding v s'
    where s = getInteractiveScaffolding v
          s' = s{ sizeX = p }

setSizeY :: Interactive a => Double -> a -> a
setSizeY p v = setInteractiveScaffolding v s'
    where s = getInteractiveScaffolding v
          s' = s{ sizeY = p }

setImageCache :: Interactive a => Maybe ImageCache -> a -> a
setImageCache p v = setInteractiveScaffolding v s'
    where s = getInteractiveScaffolding v
          s' = s{ imageCache = p }