-- This is just a simple example to organize some random thought.
-- Of course, GIO ideas can be combined with these.

-- There are two things I want people to notice:
--
-- 1. Widgets aren't necessarily produced by IO actions, since they
-- CONTAIN an IO action.
--
-- 2. The use of Vars to model the state of the widgets.

module GUI where

import Directory
import qualified Gtk

import IORef
import Monad
import Var
import Concurrent
import Exception

import qualified Structs

data Application =
    Application { quit :: Input () }

data Button = 
    Button { buttonClicked :: Output (),
	     buttonLabel :: Input String }

data Label = Label { labelLabel :: Input String }

data Window = Window { windowWidget :: Input Widget }

data VBox = VBox { vboxWidgets :: Input [Widget] }

data Widget = forall a . Gtk.WidgetClass a => Widget (IO a)

managedButton :: String -> IO (Widget,Button)
managedButton label = do 
		     textVar <- stateVar label
		     clickVar <- stateVar ()
		     return (Widget (do
				     b <- Gtk.buttonNewWithLabel label
				     Gtk.onClicked b (putVar clickVar () >> Gtk.widgetQueueDraw b)
				     onVar textVar (Gtk.buttonSetLabel b)
				     return b),
			     Button { buttonClicked = varOutput clickVar,
				      buttonLabel = varInput textVar })


button :: String -> Widget
button label = Widget (Gtk.buttonNewWithLabel label)

label :: String -> Widget
label l = Widget (Gtk.labelNew (Just l))

managedLabel :: String -> IO (Widget,Label)
managedLabel l = do
		 v <- stateVar l
		 return (Widget (do
				 l1 <- Gtk.labelNew (Just l)				 
				 onVar v (Gtk.labelSetText l1)
				 return l1),
			 Label { labelLabel = varInput v })

vBox :: [Widget] -> Widget
vBox l = 
    Widget (do 
	    vb <- Gtk.vBoxNew False 0
	    mapM_ (\ (Widget x) -> (do
				    y <- x
				    Gtk.containerAdd vb y
				    Gtk.widgetShow y)) l
	    return vb)

hBox :: [Widget] -> Widget
hBox l = 
    Widget (do 
	    hb <- Gtk.hBoxNew False 0
	    mapM_ (\ (Widget x) -> (do
				    y <- x
				    Gtk.containerAdd hb y
				    Gtk.widgetShow y)) l
	    return hb)

window :: Widget -> Widget
window (Widget w) =
    Widget (do
	    x <- w
	    win <- Gtk.windowNew
	    Gtk.containerAdd win x
	    Gtk.widgetShow x
	    Gtk.widgetShow win
	    return win)

whileM c a = do
             b <- c
	     if b 
		then a >> whileM c a 
		else return ()


-- Don't pay attention to this function, there are better ways to define this,
-- but in some occasions I have had troubles, and this is the best working on 
-- my system by now. Moreover, this is not gtk2hs fault I believe.
runGUI :: Widget -> IO Application
runGUI (Widget w) =
    do forkIO (do
	       Gtk.initGUI
	       w
	       dontexit <- newIORef True
	       whileM (readIORef dontexit)
	        (do
		 threadDelay 20000
		 whileM (Gtk.eventsPending >>= return . (0<)) (Gtk.mainIterationDo False >>=
							       writeIORef dontexit)))       
       return (Application (Input (\ () -> Gtk.mainQuit)))