Initial commit

1 files changed, 77 insertions, 0 deletions

diff --git a/src/Gtk/Internal.icl b/src/Gtk/Internal.icl
new file mode 100644
index 0000000..827cae6
--- /dev/null
+++ b/src/Gtk/Internal.icl
@@ -0,0 +1,77 @@
+implementation module Gtk.Internal
+
+import StdEnv
+import StdMaybe
+
+import System._Pointer
+
+import code from "clean_gtk_support."
+
+g_object_unref :: !Pointer !.a -> .a
+g_object_unref p env = code {
+	ccall g_object_unref "p:V:A"
+}
+
+g_signal_connect_void :: !Pointer !String !Int !.a -> .a
+g_signal_connect_void widget signal id env = connect widget (packString signal) id env
+where
+	connect :: !Pointer !String !Int !.a -> .a
+	connect _ _ _ _ = code {
+		ccall clean_g_signal_connect_void "psI:V:A"
+	}
+
+g_signal_pop :: !.a -> (!Maybe GSignalArgs, !.a)
+g_signal_pop env
+	# (sig,env) = pop env
+	| sig == 0
+		= (Nothing, env)
+	# (id,sig) = readIntP sig (IF_INT_64_OR_32 8 4)
+	| sig == 0 // force evaluation
+		= abort "Internal error in g_signal_pop\n"
+		= (Just {sig_id=id}, env)
+where
+	pop :: !.a -> (!Pointer, !.a)
+	pop env = code {
+		ccall clean_g_signal_pop ":p:A"
+	}
+
+gtk_init :: !.a -> .a
+gtk_init env = init 0 0 env
+where
+	init :: !Pointer !Pointer !.a -> .a
+	init argc argv env = code {
+		ccall gtk_init "pp:V:A"
+	}
+
+gtk_main_iteration :: !.a -> (!Bool, !.a)
+gtk_main_iteration env = code {
+	ccall gtk_main_iteration ":I:A"
+}
+
+gtk_main_quit :: !.a -> .a
+gtk_main_quit env = code {
+	ccall gtk_main_quit ":V:A"
+}
+
+gtk_widget_set_size_request :: !Pointer !Int !Int !.a -> .a
+gtk_widget_set_size_request widget hsize vsize env = code {
+	ccall gtk_widget_set_size_request "pII:V:A"
+}
+
+gtk_widget_show_all :: !Pointer !.a -> .a
+gtk_widget_show_all widget env = code {
+	ccall gtk_widget_show_all "p:V:A"
+}
+
+gtk_window_new :: !Bool !.a -> (!Pointer, !.a)
+gtk_window_new is_popup env = code {
+	ccall gtk_window_new "I:p:A"
+}
+
+gtk_window_set_title :: !Pointer !String !.a -> .a
+gtk_window_set_title window title env = set window (packString title) env
+where
+	set :: !Pointer !String !.a -> .a
+	set _ _ _ = code {
+		ccall gtk_window_set_title "ps:V:A"
+	}