apelsin-1.1: src/Apelsin.hs

import Graphics.UI.Gtk
import System.Glib.GError

import Control.Applicative
import Control.Monad.IO.Class
import Control.Exception
import Control.Monad
import Data.Char (toLower)
import qualified Data.Set as S
import Network.Socket
import Network.Tremulous.Protocol
import System.FilePath (joinPath)

import Types
import Constants
import GtkUtils
import ServerInfo
import ServerBrowser
import FindPlayers
import Clanlist
import ClanFetcher
import Preferences
import Config
import Toolbar

main :: IO ()
main = withSocketsDo $ do
	unsafeInitGUIForThreadedRTS
	win		<- windowNew
	config		<- configFromFile
	cacheclans	<- clanListFromCache
	bundle	<-	(do
			mpolled		<- atomically $ newTMVar (PollResult [] 0 0 S.empty)
			mconfig		<- atomically $ newTMVar config
			mclans		<- atomically $ newTMVar cacheclans
			browserStore	<- listStoreNew []
			return Bundle {parent = win, ..}
			)
	mupdate <- atomically newEmptyTMVar
	(currentInfo, currentUpdate, currentSet)<- newServerInfo bundle mupdate
	(browser, browserUpdate, ent0)		<- newServerBrowser bundle currentSet
	(findPlayers, findUpdate, ent1)		<- newFindPlayers bundle currentSet
	(clanlist, clanlistUpdate, ent3)	<- newClanList bundle cacheclans currentSet
	(onlineclans, onlineclansUpdate)	<- newOnlineClans bundle currentSet

	preferences				<- newPreferences bundle
	atomically $ putTMVar mupdate (findUpdate, onlineclansUpdate)

	toolbar <- newToolbar bundle
		[]
		[browserUpdate, findUpdate, currentUpdate]
		[onlineclansUpdate, clanlistUpdate]

	-- /// Layout ////////////////////////////////////////////////////////////////////////////

	book <- notebookNew
	notebookAppendPage book browser		"Browser"
	notebookAppendPage book findPlayers	"Find players"
	notebookAppendPage book onlineclans	"Online clans"
	notebookAppendPage book clanlist	"Clan list"
	notebookAppendPage book preferences	"Preferences"
	leftView <- vBoxNew False 0
	boxPackStart leftView toolbar PackNatural 0
	boxPackStart leftView book PackGrow 0
	

	pane <- hPanedNew
	panedPack1 pane leftView True False
	panedPack2 pane currentInfo  False True


	-- save the current window size and pane positon on exit
	on win deleteEvent $ tryEvent $ liftIO $ do
		Config {autoGeometry} <- atomically $ readTMVar (mconfig bundle)
		when autoGeometry $ do
			file		<- inCacheDir "windowsize"
			(winw, winh)	<- windowGetSize win
			ppos		<- panedGetPosition pane
			writeFile file $ show (winw, winh, ppos)
		mainQuit

	ddir <- getDataDir
	handleGError (const $ trace $ "Window icon not found in: " ++ ddir) $ do
		let list = map
			(\x -> joinPath [ddir, "icons", "hicolor", x ++ "x" ++ x, "apps", "apelsin.png"])
			["16", "32", "48", "64"]
		icons <- mapM pixbufNewFromFile list
		set win [ windowIconList := icons]
	
	-- Without allowshrink the window may change size back and forth when selecting new servers
	set win [ containerChild	:= pane
		, windowTitle		:= fullProgramName
		, windowAllowShrink	:= True
		]

	--Showing it to get size requests
	widgetShowAll leftView

	-- Restore the window size and pane position
	when (autoGeometry config) $ handle ignoreIOException $ do
		file	<- inCacheDir "windowsize"
		fx	<- readFile file
		whenJust (mread fx) $ \(winw::Int, winh, ppos::Int) -> do
			Requisition  _ minh	<- widgetSizeRequest leftView
			Requisition minw _	<- widgetSizeRequest leftView
			let panebuf = 15 -- size we assume the panehandle is at most
			panedSetPosition pane (if minw+panebuf > winw then ppos+panebuf else ppos)
			set win [ widgetHeightRequest	:= max minh winh
				, widgetWidthRequest	:= max (minw+panebuf) winw ]
	widgetShowAll win

	on win keyPressEvent $  do
		kmod	<- eventModifier
		k	<- map toLower <$> eventKeyName
		case kmod of
			[Alt]	| Just page <- mread k
				, page >= 1
				, page <= 5
				-> do	liftIO (set book [ notebookPage := page - 1])
					return True
			[Control]
				| k == "l" || k == "f"
				-> do	page <- liftIO (get book notebookPage)
					case page of
						0 -> liftIO $ widgetGrabFocus ent0
						1 -> liftIO $ widgetGrabFocus ent1
						3 -> liftIO $ widgetGrabFocus ent3
						_ -> return ()
					return True
			_ -> return False
			
	widgetGrabFocus ent0
	mainGUI


ignoreIOException :: IOException -> IO ()
ignoreIOException _ = return ()