summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorCamil Staps2019-10-20 10:02:46 +0200
committerCamil Staps2019-10-20 10:02:46 +0200
commitc0b119e20d4874bd330c9cd9d352fd2666f19191 (patch)
treeb4122ed9e831a2f6916626a61dd60f6dae9570c4 /src
parentInitial commit (diff)
Add rudimentary support for GtkPaned and GtkTextView
Diffstat (limited to 'src')
-rw-r--r--src/Gtk/Internal.dcl14
-rw-r--r--src/Gtk/Internal.icl46
-rw-r--r--src/Gtk/Signal.icl2
-rw-r--r--src/Gtk/Types.dcl17
-rw-r--r--src/Gtk/Types.icl1
-rw-r--r--src/Gtk/Widgets.dcl45
-rw-r--r--src/Gtk/Widgets.icl68
7 files changed, 171 insertions, 22 deletions
diff --git a/src/Gtk/Internal.dcl b/src/Gtk/Internal.dcl
index 14bb9ab..d0c938a 100644
--- a/src/Gtk/Internal.dcl
+++ b/src/Gtk/Internal.dcl
@@ -13,13 +13,25 @@ g_object_unref :: !Pointer !.a -> .a
g_signal_connect_void :: !Pointer !String !Int !.a -> .a
g_signal_pop :: !.a -> (!Maybe GSignalArgs, !.a)
+gtk_container_add :: !Pointer !Pointer !.a -> .a
+
gtk_init :: !.a -> .a
gtk_main_iteration :: !.a -> (!Bool, !.a)
gtk_main_quit :: !.a -> .a
+gtk_paned_new :: !Bool !.a -> (!Pointer, !.a)
+gtk_paned_pack1 :: !Pointer !Pointer !Bool !Bool !.a -> .a
+gtk_paned_pack2 :: !Pointer !Pointer !Bool !Bool !.a -> .a
+gtk_paned_set_wide_handle :: !Pointer !Bool !.a -> .a
+
+gtk_text_buffer_insert_at_cursor :: !Pointer !String !Int !.a -> .a
+
+gtk_text_view_new :: !.a -> (!Pointer, !.a)
+gtk_text_view_get_buffer :: !Pointer -> Pointer
+
gtk_widget_set_size_request :: !Pointer !Int !Int !.a -> .a
-gtk_widget_show_all :: !Pointer !.a -> .a
+gtk_widget_show :: !Pointer !.a -> .a
gtk_window_new :: !Bool !.a -> (!Pointer, !.a)
gtk_window_set_title :: !Pointer !String !.a -> .a
diff --git a/src/Gtk/Internal.icl b/src/Gtk/Internal.icl
index 827cae6..b88a703 100644
--- a/src/Gtk/Internal.icl
+++ b/src/Gtk/Internal.icl
@@ -35,6 +35,11 @@ where
ccall clean_g_signal_pop ":p:A"
}
+gtk_container_add :: !Pointer !Pointer !.a -> .a
+gtk_container_add container widget env = code {
+ ccall gtk_container_add "pp:V:A"
+}
+
gtk_init :: !.a -> .a
gtk_init env = init 0 0 env
where
@@ -53,14 +58,49 @@ gtk_main_quit env = code {
ccall gtk_main_quit ":V:A"
}
+gtk_paned_new :: !Bool !.a -> (!Pointer, !.a)
+gtk_paned_new vertical env = code {
+ ccall gtk_paned_new "I:p:A"
+}
+
+gtk_paned_pack1 :: !Pointer !Pointer !Bool !Bool !.a -> .a
+gtk_paned_pack1 paned child resize shrink env = code {
+ ccall gtk_paned_pack1 "ppII:V:A"
+}
+
+gtk_paned_pack2 :: !Pointer !Pointer !Bool !Bool !.a -> .a
+gtk_paned_pack2 paned child resize shrink env = code {
+ ccall gtk_paned_pack2 "ppII:V:A"
+}
+
+gtk_paned_set_wide_handle :: !Pointer !Bool !.a -> .a
+gtk_paned_set_wide_handle paned setting env = code {
+ ccall gtk_paned_set_wide_handle "pI:V:A"
+}
+
+gtk_text_buffer_insert_at_cursor :: !Pointer !String !Int !.a -> .a
+gtk_text_buffer_insert_at_cursor buffer string len env = code {
+ ccall gtk_text_buffer_insert_at_cursor "psI:V:A"
+}
+
+gtk_text_view_new :: !.a -> (!Pointer, !.a)
+gtk_text_view_new env = code {
+ ccall gtk_text_view_new ":p:A"
+}
+
+gtk_text_view_get_buffer :: !Pointer -> Pointer
+gtk_text_view_get_buffer text_view = code {
+ ccall gtk_text_view_get_buffer "p:p"
+}
+
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_widget_show :: !Pointer !.a -> .a
+gtk_widget_show widget env = code {
+ ccall gtk_widget_show "p:V:A"
}
gtk_window_new :: !Bool !.a -> (!Pointer, !.a)
diff --git a/src/Gtk/Signal.icl b/src/Gtk/Signal.icl
index 4bc14b5..d98a14d 100644
--- a/src/Gtk/Signal.icl
+++ b/src/Gtk/Signal.icl
@@ -20,7 +20,7 @@ installSignalHandler widget handler =
}) >>|
gets (\st -> st.signal_counter) >>= \id ->
toState case handler_internal of
- GSHI_Void _ -> 'I'.g_signal_connect_void (gtkPtr widget) signal_name id
+ GSHI_Void _ -> 'I'.g_signal_connect_void (ptr (gtkWidget widget)) signal_name id
where
(signal_name,handler_internal) = case handler of
DestroyHandler f -> ("destroy",GSHI_Void f)
diff --git a/src/Gtk/Types.dcl b/src/Gtk/Types.dcl
new file mode 100644
index 0000000..c331bf8
--- /dev/null
+++ b/src/Gtk/Types.dcl
@@ -0,0 +1,17 @@
+definition module Gtk.Types
+
+:: GtkOrientation
+ = Horizontal
+ | Vertical
+
+:: GtkPanedHandleWidth
+ = WideHandle
+ | NarrowHandle
+
+:: GtkResize
+ = Resize
+ | NoResize
+
+:: GtkShrink
+ = Shrink
+ | NoShrink
diff --git a/src/Gtk/Types.icl b/src/Gtk/Types.icl
new file mode 100644
index 0000000..55b6e28
--- /dev/null
+++ b/src/Gtk/Types.icl
@@ -0,0 +1 @@
+implementation module Gtk.Types
diff --git a/src/Gtk/Widgets.dcl b/src/Gtk/Widgets.dcl
index d27d70d..8147c41 100644
--- a/src/Gtk/Widgets.dcl
+++ b/src/Gtk/Widgets.dcl
@@ -5,16 +5,49 @@ from StdMaybe import :: Maybe
from System._Pointer import :: Pointer
from Gtk.State import :: State, :: StateT, :: Identity, :: GtkState
+from Gtk.Types import :: GtkOrientation, :: GtkPanedHandleWidth, :: GtkResize,
+ :: GtkShrink
+
+class ptr a :: !a -> Pointer
:: GtkWidget
-:: GtkWindow
-class gtkWidget a
-where
- gtkWidget :: !a -> GtkWidget
- gtkPtr :: !a -> Pointer
+class gtkWidget a :: !a -> GtkWidget
+
+instance gtkWidget GtkWidget
+instance ptr GtkWidget
+
+:: GtkContainer
+
+class gtkContainer a :: !a -> GtkContainer
+
+instance gtkWidget GtkContainer
+instance gtkContainer GtkContainer
+
+addToContainer :: !w !c -> State GtkState () | gtkWidget w & gtkContainer c
-instance gtkWidget GtkWidget, GtkWindow
+:: GtkPaned
+instance gtkWidget GtkPaned
+instance gtkContainer GtkPaned
+
+newPaned :: !GtkOrientation !GtkPanedHandleWidth -> State GtkState GtkPaned
+packPane1 :: !w !GtkPaned !GtkResize !GtkShrink -> State GtkState () | gtkWidget w
+packPane2 :: !w !GtkPaned !GtkResize !GtkShrink -> State GtkState () | gtkWidget w
+
+:: GtkTextBuffer
+
+insertAtCursor :: !String !GtkTextBuffer -> State GtkState ()
+
+:: GtkTextView
+instance gtkWidget GtkTextView
+instance gtkContainer GtkTextView
+
+newTextView :: State GtkState GtkTextView
+getTextBuffer :: !GtkTextView -> GtkTextBuffer
+
+:: GtkWindow
+instance gtkWidget GtkWindow
+instance gtkContainer GtkWindow
newPopup :: !String !(Maybe (Int,Int)) -> State GtkState GtkWindow
newWindow :: !String !(Maybe (Int,Int)) -> State GtkState GtkWindow
diff --git a/src/Gtk/Widgets.icl b/src/Gtk/Widgets.icl
index dfeb901..0438525 100644
--- a/src/Gtk/Widgets.icl
+++ b/src/Gtk/Widgets.icl
@@ -10,19 +10,65 @@ import System._Pointer
import qualified Gtk.Internal as I
import Gtk.State
+import Gtk.Types
-:: GtkWidget :== Int
-:: GtkWindow :== Int
+:: GtkWidget :== Pointer
-instance gtkWidget GtkWidget
-where
- gtkWidget w = w
- gtkPtr w = w
+instance gtkWidget GtkWidget where gtkWidget w = w
+instance ptr GtkWidget where ptr w = w
-instance gtkWidget GtkWindow
-where
- gtkWidget w = w
- gtkPtr w = w
+:: GtkContainer :== Pointer
+
+instance gtkWidget GtkContainer where gtkWidget c = c
+instance gtkContainer GtkContainer where gtkContainer c = c
+
+addToContainer :: !w !c -> State GtkState () | gtkWidget w & gtkContainer c
+addToContainer widget container =
+ toState ('I'.gtk_container_add (gtkContainer container) (gtkWidget widget))
+
+:: GtkPaned :== Pointer
+
+instance gtkWidget GtkPaned where gtkWidget p = p
+instance gtkContainer GtkPaned where gtkContainer p = p
+
+newPaned :: !GtkOrientation !GtkPanedHandleWidth -> State GtkState GtkPaned
+newPaned orientation handle_width =
+ toStateR ('I'.gtk_paned_new orientation=:Vertical) >>= \paned ->
+ toState ('I'.gtk_paned_set_wide_handle paned handle_width=:WideHandle) >>|
+ toState ('I'.gtk_widget_show paned) >>|
+ pure paned
+
+packPane1 :: !w !GtkPaned !GtkResize !GtkShrink -> State GtkState () | gtkWidget w
+packPane1 widget paned resize shrink =
+ toState ('I'.gtk_paned_pack1 paned (gtkWidget widget) resize=:Resize shrink=:Shrink)
+
+packPane2 :: !w !GtkPaned !GtkResize !GtkShrink -> State GtkState () | gtkWidget w
+packPane2 widget paned resize shrink =
+ toState ('I'.gtk_paned_pack2 paned (gtkWidget widget) resize=:Resize shrink=:Shrink)
+
+:: GtkTextBuffer :== Pointer
+
+insertAtCursor :: !String !GtkTextBuffer -> State GtkState ()
+insertAtCursor s buffer = toState ('I'.gtk_text_buffer_insert_at_cursor buffer s (size s))
+
+:: GtkTextView :== Pointer
+
+instance gtkWidget GtkTextView where gtkWidget tv = tv
+instance gtkContainer GtkTextView where gtkContainer tv = tv
+
+newTextView :: State GtkState GtkTextView
+newTextView =
+ toStateR 'I'.gtk_text_view_new >>= \text_view ->
+ toState ('I'.gtk_widget_show text_view) >>|
+ pure text_view
+
+getTextBuffer :: !GtkTextView -> GtkTextBuffer
+getTextBuffer text_view = 'I'.gtk_text_view_get_buffer text_view
+
+:: GtkWindow :== Pointer
+
+instance gtkWidget GtkWindow where gtkWidget w = w
+instance gtkContainer GtkWindow where gtkContainer w = w
newPopup :: !String !(Maybe (Int,Int)) -> State GtkState GtkWindow
newPopup title size = new_window_or_popup True title size
@@ -37,5 +83,5 @@ new_window_or_popup is_popup title size =
(case size of
Nothing -> pure ()
Just (h,v) -> toState ('I'.gtk_widget_set_size_request window h v)) >>|
- toState ('I'.gtk_widget_show_all window) >>|
+ toState ('I'.gtk_widget_show window) >>|
pure window