packages feed

moffy-samples-gtk3-run-0.1.0.0: src/Stopgap/Graphics/UI/Gtk.hsc

{-# LANGUAGE BlockArguments #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Stopgap.Graphics.UI.Gtk where

import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String

init :: String -> [String] -> IO ()
init cmd as = withArgcArgv cmd as c_gtk_init

withArgcArgv :: String -> [String] -> (Ptr CInt -> Ptr (Ptr CString) -> IO a) -> IO a
withArgcArgv cmd as f = withCStringList (cmd : as) \cas ->
	withArrayLen cas \argc argv ->
		alloca \pargc -> alloca \pargv -> do
			poke pargc (fromIntegral argc)
			poke pargv argv
			f pargc pargv

withCStringList :: [String] -> ([CString] -> IO a) -> IO a
withCStringList [] f = f []
withCStringList (a : as) f =
	withCString a \ca -> withCStringList as \cas -> f $ ca : cas

foreign import ccall "gtk_init" c_gtk_init :: Ptr CInt -> Ptr (Ptr CString) -> IO ()

main :: IO ()
main = c_gtk_main

foreign import ccall "gtk_main" c_gtk_main :: IO ()

mainQuit :: IO ()
mainQuit = c_gtk_main_quit

foreign import ccall "gtk_main_quit" c_gtk_main_quit :: IO ()