{-# LANGUAGE CPP #-}
module Termonad.Gtk where
import Termonad.Prelude
import Data.GI.Base (ManagedPtr, withManagedPtr)
import Data.Text (unpack)
import GHC.Stack (HasCallStack)
import GI.Gdk
( GObject
, castTo
)
import GI.GdkPixbuf (Pixbuf, pixbufNewFromStream)
import GI.Gio (ApplicationFlags, Cancellable)
import GI.Gio.Objects.MemoryInputStream (memoryInputStreamNewFromData)
import GI.Gtk (Application, IsWidget, Widget(Widget), applicationNew, builderGetObject, toWidget)
import qualified GI.Gtk as Gtk
import GI.Vte
( IsTerminal
#ifdef VTE_VERSION_GEQ_0_63
, terminalSetEnableSixel
#endif
)
import System.Exit (die)
objFromBuildUnsafe ::
GObject o => Gtk.Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe :: forall o.
GObject o =>
Builder -> Text -> (ManagedPtr o -> o) -> IO o
objFromBuildUnsafe Builder
builder Text
name ManagedPtr o -> o
constructor = do
Maybe Object
maybePlainObj <- Builder -> Text -> IO (Maybe Object)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBuilder a) =>
a -> Text -> m (Maybe Object)
builderGetObject Builder
builder Text
name
case Maybe Object
maybePlainObj of
Maybe Object
Nothing -> [Char] -> IO o
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO o) -> [Char] -> IO o
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text
"Couldn't get " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from builder!"
Just Object
plainObj -> do
Maybe o
maybeNewObj <- (ManagedPtr o -> o) -> Object -> IO (Maybe o)
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o', GObject o') =>
(ManagedPtr o' -> o') -> o -> IO (Maybe o')
castTo ManagedPtr o -> o
constructor Object
plainObj
case Maybe o
maybeNewObj of
Maybe o
Nothing -> [Char] -> IO o
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO o) -> [Char] -> IO o
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text
"Got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from builder, but couldn't convert to object!"
Just o
obj -> o -> IO o
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure o
obj
appNew ::
(HasCallStack, MonadIO m, MonadFail m)
=> Maybe Text
-> [ApplicationFlags]
-> m Application
appNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadFail m) =>
Maybe Text -> [ApplicationFlags] -> m Application
appNew Maybe Text
appName [ApplicationFlags]
appFlags = do
Maybe Application
maybeApp <- Maybe Text -> [ApplicationFlags] -> m (Maybe Application)
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> [ApplicationFlags] -> m (Maybe Application)
applicationNew Maybe Text
appName [ApplicationFlags]
appFlags
case Maybe Application
maybeApp of
Maybe Application
Nothing -> [Char] -> m Application
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Could not create application for some reason!"
Just Application
app -> Application -> m Application
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Application
app
widgetEq :: (MonadIO m, IsWidget a, IsWidget b) => a -> b -> m Bool
widgetEq :: forall (m :: * -> *) a b.
(MonadIO m, IsWidget a, IsWidget b) =>
a -> b -> m Bool
widgetEq a
a b
b = do
Widget ManagedPtr Widget
managedPtrA <- a -> m Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
toWidget a
a
Widget ManagedPtr Widget
managedPtrB <- b -> m Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
toWidget b
b
IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
ManagedPtr Widget
-> (Ptr (ManagedPtr Widget) -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ManagedPtr Widget
managedPtrA ((Ptr (ManagedPtr Widget) -> IO Bool) -> IO Bool)
-> (Ptr (ManagedPtr Widget) -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr (ManagedPtr Widget)
ptrA ->
ManagedPtr Widget
-> (Ptr (ManagedPtr Widget) -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ManagedPtr Widget
managedPtrB ((Ptr (ManagedPtr Widget) -> IO Bool) -> IO Bool)
-> (Ptr (ManagedPtr Widget) -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr (ManagedPtr Widget)
ptrB ->
Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr (ManagedPtr Widget)
ptrA Ptr (ManagedPtr Widget) -> Ptr (ManagedPtr Widget) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (ManagedPtr Widget)
ptrB)
terminalSetEnableSixelIfExists
:: (HasCallStack, MonadIO m, IsTerminal t)
=> t
-> Bool
-> m ()
terminalSetEnableSixelIfExists :: forall (m :: * -> *) t.
(HasCallStack, MonadIO m, IsTerminal t) =>
t -> Bool -> m ()
terminalSetEnableSixelIfExists t
t Bool
b = do
#ifdef VTE_VERSION_GEQ_0_63
terminalSetEnableSixel t b
#endif
() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
imgToPixbuf :: ByteString -> IO Pixbuf
imgToPixbuf :: ByteString -> IO Pixbuf
imgToPixbuf ByteString
imgByteString = do
MemoryInputStream
inputStream <- ByteString -> Maybe DestroyNotify -> IO MemoryInputStream
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> Maybe DestroyNotify -> m MemoryInputStream
memoryInputStreamNewFromData ByteString
imgByteString Maybe DestroyNotify
forall a. Maybe a
Nothing
Maybe Pixbuf
maybePixbuf <- MemoryInputStream -> Maybe Cancellable -> IO (Maybe Pixbuf)
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsInputStream a, IsCancellable b) =>
a -> Maybe b -> m (Maybe Pixbuf)
pixbufNewFromStream MemoryInputStream
inputStream (Maybe Cancellable
forall a. Maybe a
Nothing :: Maybe Cancellable)
case Maybe Pixbuf
maybePixbuf of
Maybe Pixbuf
Nothing ->
[Char] -> IO Pixbuf
forall a. [Char] -> IO a
die [Char]
"imgToPixbuf: Unexpected error when trying to convert an image to a Pixbuf"
Just Pixbuf
pixbuf -> Pixbuf -> IO Pixbuf
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pixbuf
pixbuf