-- Copyright 2014 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE DeriveDataTypeable #-}
-- | This holds the 'view_id_to_ptr' global variable.  Only very low level
-- modules should import this.
module Ui.PtrMap (
    -- * error
    FltkException(..), throw
    -- * views
    , CView, modify, get_map, get, lookup, lookup_id
    , view_exists
    -- * keycaps
    , lookup_keycaps, set_keycaps
) where
import           Prelude hiding (lookup)
import qualified Control.Concurrent.MVar as MVar
import qualified Control.Exception as Exception
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Typeable as Typeable

import           ForeignC (Ptr)
import qualified System.IO.Unsafe as Unsafe

import qualified Ui.KeycapsT as KeycapsT

import           Global
import           Types


-- * error

newtype FltkException = FltkException String deriving (Typeable.Typeable)
instance Exception.Exception FltkException
instance Show FltkException where
    show :: FltkException -> [Char]
show (FltkException [Char]
msg) = [Char]
"FltkException: " forall a. [a] -> [a] -> [a]
++ [Char]
msg

throw :: String -> IO a
throw :: forall a. [Char] -> IO a
throw = forall e a. Exception e => e -> IO a
Exception.throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> FltkException
FltkException

-- * views

-- | Phantom type for block view ptrs.
data CView

-- | Global map of view IDs to their windows.  This is global mutable state,
-- but I don't feel too bad about it because the underlying window system
-- state is also global mutable state, and this is just a handle on that.
{-# NOINLINE global_windows #-}
global_windows :: MVar.MVar Windows
global_windows :: MVar Windows
global_windows = forall a. IO a -> a
Unsafe.unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
MVar.newMVar forall a b. (a -> b) -> a -> b
$ Windows
    { _blocks :: Map ViewId (Ptr CView)
_blocks = forall k a. Map k a
Map.empty
    , _keycaps :: Maybe (Ptr CWindow)
_keycaps = forall a. Maybe a
Nothing
    }

data Windows = Windows {
    Windows -> Map ViewId (Ptr CView)
_blocks :: Map ViewId (Ptr CView)
    , Windows -> Maybe (Ptr CWindow)
_keycaps :: Maybe (Ptr KeycapsT.CWindow)
    }

modify :: (Map ViewId (Ptr CView) -> IO (Map ViewId (Ptr CView))) -> IO ()
modify :: (Map ViewId (Ptr CView) -> IO (Map ViewId (Ptr CView))) -> IO ()
modify Map ViewId (Ptr CView) -> IO (Map ViewId (Ptr CView))
modify = forall a. MVar a -> (a -> IO a) -> IO ()
MVar.modifyMVar_ MVar Windows
global_windows forall a b. (a -> b) -> a -> b
$ \Windows
windows -> do
    Map ViewId (Ptr CView)
blocks <- Map ViewId (Ptr CView) -> IO (Map ViewId (Ptr CView))
modify (Windows -> Map ViewId (Ptr CView)
_blocks Windows
windows)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Windows
windows { _blocks :: Map ViewId (Ptr CView)
_blocks = Map ViewId (Ptr CView)
blocks }

get_map :: IO (Map ViewId (Ptr CView))
get_map :: IO (Map ViewId (Ptr CView))
get_map = Windows -> Map ViewId (Ptr CView)
_blocks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. MVar a -> IO a
MVar.readMVar MVar Windows
global_windows

get :: ViewId -> IO (Ptr CView)
get :: ViewId -> IO (Ptr CView)
get ViewId
view_id = do
    Map ViewId (Ptr CView)
blocks <- Windows -> Map ViewId (Ptr CView)
_blocks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. MVar a -> IO a
MVar.readMVar MVar Windows
global_windows
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ViewId
view_id Map ViewId (Ptr CView)
blocks of
        Maybe (Ptr CView)
Nothing -> forall a. [Char] -> IO a
throw forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show ViewId
view_id forall a. [a] -> [a] -> [a]
++ [Char]
" not in displayed view list: "
            forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall k a. Map k a -> [(k, a)]
Map.assocs Map ViewId (Ptr CView)
blocks)
        Just Ptr CView
viewp -> forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CView
viewp

lookup :: ViewId -> IO (Maybe (Ptr CView))
lookup :: ViewId -> IO (Maybe (Ptr CView))
lookup ViewId
view_id = do
    Map ViewId (Ptr CView)
blocks <- Windows -> Map ViewId (Ptr CView)
_blocks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. MVar a -> IO a
MVar.readMVar MVar Windows
global_windows
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ViewId
view_id Map ViewId (Ptr CView)
blocks

-- | Nothing indicates that the UI returned a view ptr I didn't know I had.
-- It's rare, but it can happen if I close a window but a msg about it is still
-- in the queue.
lookup_id :: Ptr CView -> IO (Maybe ViewId)
lookup_id :: Ptr CView -> IO (Maybe ViewId)
lookup_id Ptr CView
viewp = do
    Map ViewId (Ptr CView)
blocks <- Windows -> Map ViewId (Ptr CView)
_blocks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. MVar a -> IO a
MVar.readMVar MVar Windows
global_windows
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((forall a. Eq a => a -> a -> Bool
==Ptr CView
viewp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall k a. Map k a -> [(k, a)]
Map.toList Map ViewId (Ptr CView)
blocks)

view_exists :: ViewId -> IO Bool
view_exists :: ViewId -> IO Bool
view_exists = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
Maybe.isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewId -> IO (Maybe (Ptr CView))
lookup

-- * keycaps

lookup_keycaps :: IO (Maybe (Ptr KeycapsT.CWindow))
lookup_keycaps :: IO (Maybe (Ptr CWindow))
lookup_keycaps = Windows -> Maybe (Ptr CWindow)
_keycaps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. MVar a -> IO a
MVar.readMVar MVar Windows
global_windows

set_keycaps :: Maybe (Ptr KeycapsT.CWindow) -> IO ()
set_keycaps :: Maybe (Ptr CWindow) -> IO ()
set_keycaps Maybe (Ptr CWindow)
keycaps = forall a. MVar a -> (a -> IO a) -> IO ()
MVar.modifyMVar_ MVar Windows
global_windows forall a b. (a -> b) -> a -> b
$ \Windows
windows ->
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Windows
windows { _keycaps :: Maybe (Ptr CWindow)
_keycaps = Maybe (Ptr CWindow)
keycaps }