apelsin-1.0: src/FindPlayers.hs

module FindPlayers where
import Graphics.UI.Gtk

import Data.IORef
import qualified Data.ByteString.Char8 as B
import Network.Tremulous.Protocol
import Network.Tremulous.Util

import Types
import GtkUtils
import TremFormatting
import FilterBar
import InfoBox
import Constants
import Config

newFindPlayers :: Bundle -> (Bool -> GameServer -> IO ()) -> IO (VBox, IO ())
newFindPlayers Bundle{..} setServer = do
	Config {colors} <- atomically $ readTMVar mconfig
	rawmodel	<- listStoreNew []
	model		<- treeModelFilterNew rawmodel []
	view		<- treeViewNewWithModel model
	
	addColumnsFilter rawmodel model view [
		  ("Name", True, pangoPretty colors . fst)
		, ("Server", True, pangoPretty colors . hostname . snd) 
		]

	(infobox, statNow, statTot) <- newInfobox "players"
	Config {filterPlayers} <- atomically $ readTMVar mconfig
	(filterbar, current)	<- newFilterBar model statNow filterPlayers
	
	treeModelFilterSetVisibleFunc model $ \iter -> do
		(item,_) <- treeModelGetRow rawmodel iter
		s <- readIORef current
		return $ B.null s || s `B.isInfixOf` cleanedCase item
		
	let updateFilter = do
		PollResult{..} <- atomically $ readTMVar mpolled
		listStoreClear rawmodel
		let plist = makePlayerNameList polled
		mapM_ (listStoreAppend rawmodel) plist
		treeModelFilterRefilter model
		set statTot [ labelText := show (length plist) ]
		n <- treeModelIterNChildren model Nothing
		set statNow [ labelText := show n ]
						
	onCursorChanged view $ do
		(x, _) <- treeViewGetCursor view
		Just vIter <- treeModelGetIter model x
		iter	<-treeModelFilterConvertIterToChildIter model vIter
		gameserver <- treeModelGetRow rawmodel iter
		setServer False (snd gameserver)
		return ()

	onRowActivated view $ \path _ -> do
		Just vIter	<- treeModelGetIter model path
		fIter		<- treeModelFilterConvertIterToChildIter model vIter
		gameserver	<- treeModelGetRow rawmodel fIter
		setServer True (snd gameserver)
	
	scroll <- scrollIt view PolicyAutomatic PolicyAlways
	
	box <- vBoxNew False 0
	boxPackStart box filterbar PackNatural spacing
	boxPackStart box scroll PackGrow 0
	boxPackStart box infobox PackNatural 0
	
	return (box, updateFilter)