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 setMargins :: !GtkMargins !w -> GtkM () | gtkWidget w setMargins {left,top,right,bottom} widget` = let widget = gtkWidget widget` in toState ('I'.gtk_widget_set_margin_left widget left) >>| toState ('I'.gtk_widget_set_margin_top widget top) >>| toState ('I'.gtk_widget_set_margin_right widget right) >>| toState ('I'.gtk_widget_set_margin_bottom widget bottom) show :: !w -> GtkM 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 -> GtkM () | 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 -> GtkM GtkBox newBox orientation spacing = toStateR ('I'.gtk_box_new orientation=:Vertical spacing) >>= show packBox :: !w !GtkBox !GtkDirection !GtkExpand -> GtkM () | 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 -> GtkM 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 !(GtkM w) -> GtkM (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 -> GtkM 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 -> GtkM () | gtkWidget w packPane1 widget paned resize shrink = toState ('I'.gtk_paned_pack1 paned (gtkWidget widget) resize=:Resize shrink=:Shrink) packPane2 :: !w !GtkPaned !GtkResize !GtkShrink -> GtkM () | gtkWidget w packPane2 widget paned resize shrink = toState ('I'.gtk_paned_pack2 paned (gtkWidget widget) resize=:Resize shrink=:Shrink) :: GtkTextBuffer :== Pointer insertAtCursor :: !String !GtkTextBuffer -> GtkM () 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 :: GtkM 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)) -> GtkM GtkWindow newPopup title size = new_window_or_popup True title size newWindow :: !String !(Maybe (Int,Int)) -> GtkM GtkWindow newWindow title size = new_window_or_popup False title size new_window_or_popup :: !Bool !String !(Maybe (Int,Int)) -> GtkM 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