summaryrefslogtreecommitdiff
path: root/src/Gtk/Widgets.icl
blob: d9f7a596bb04bf2c084cc1215aeb22a990d7920d (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
implementation module Gtk.Widgets

import StdEnv
import StdMaybe

import Control.Monad
import Control.Monad.Identity
import Control.Monad.State
import Data.Functor
import Data.Tuple
import System._Pointer

import qualified Gtk.Internal as I
import Gtk.State
import Gtk.Types

:: GtkWidget :== Pointer

instance gtkWidget GtkWidget where gtkWidget w = w
instance ptr GtkWidget where ptr w = w

show :: !w -> State GtkState w | gtkWidget w
show widget = toState ('I'.gtk_widget_show (gtkWidget widget)) >>| pure widget

:: 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))

:: GtkBox :== Pointer

instance gtkWidget GtkBox where gtkWidget b = b
instance gtkContainer GtkBox where gtkContainer b = b

newBox :: !GtkOrientation !Int -> State GtkState GtkBox
newBox orientation spacing =
	toStateR ('I'.gtk_box_new orientation=:Vertical spacing) >>=
	show

packBox :: !w !GtkBox !GtkDirection !GtkExpand -> State GtkState () | gtkWidget w
packBox widget box direction expand =
	toState (if direction=:StartToEnd 'I'.gtk_box_pack_start 'I'.gtk_box_pack_end
		box (gtkWidget widget) expand=:Expand True 0)

:: GtkFrame :== Pointer

instance gtkWidget GtkFrame where gtkWidget f = f
instance gtkContainer GtkFrame where gtkContainer f = f

newFrame :: !GtkLabel !w -> State GtkState GtkFrame | gtkWidget w
newFrame label widget =
	toStateR ('I'.gtk_frame_new (case label of Label l -> Just l; _ -> Nothing)) >>= \frame ->
	(case label of
		Label _ -> toState ('I'.gtk_frame_set_label_align frame 0.02 0.5)
		NoLabel -> pure ()) >>|
	addToContainer widget frame >>|
	show frame

framed :: !GtkLabel !(State GtkState w) -> State GtkState (w, GtkFrame) | gtkWidget w
framed label widgetf =
	widgetf >>= \widget ->
	tuple widget <$> newFrame label 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) >>|
	show 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_text_view_set_editable text_view False) >>|
	show 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

newWindow :: !String !(Maybe (Int,Int)) -> State GtkState GtkWindow
newWindow title size = new_window_or_popup False title size

new_window_or_popup :: !Bool !String !(Maybe (Int,Int)) -> State GtkState GtkWindow
new_window_or_popup is_popup title size =
	toStateR ('I'.gtk_window_new is_popup) >>= \window ->
	toState ('I'.gtk_window_set_title window title) >>|
	(case size of
		Nothing    -> pure ()
		Just (h,v) -> toState ('I'.gtk_widget_set_size_request window h v)) >>|
	show window