apelsin-1.1: src/ServerBrowser.hs

module ServerBrowser where
import Graphics.UI.Gtk
import Control.Concurrent.STM
import Data.IORef
import qualified Data.ByteString.Char8 as B
import Data.Ord
import Network.Tremulous.Protocol
import Text.Printf

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

newServerBrowser :: Bundle -> SetCurrent -> IO (VBox, PolledHook,Entry)
newServerBrowser Bundle{browserStore=raw, ..} setServer = do
	Config {..}	<- atomically $ readTMVar mconfig
	filtered	<- treeModelFilterNew raw []
	sorted		<- treeModelSortNewWithModel filtered	
	view		<- treeViewNewWithModel sorted
	
	addColumnsFilterSort raw filtered sorted view 3 SortAscending
		[ ("_Game"	, False	, RendText (simpleColumn showGame)
		   	, Just (comparing (\x -> (protocol x, gamemod x))))
		, ("_Name"	, True	, RendText (markupColumn colors hostname)
			, Just (comparing hostname))
		, ("_Map"	, False	, RendText (simpleColumn (take 16 . unpackorig . mapname))
			, Just (comparing mapname))
		, ("P_ing"	, False	, RendText (intColumn (show . gameping))
			, Just (comparing gameping))
		, ("_Players"	, False	, RendText (intColumn (showPlayers))
			, Just (comparing nplayers))
		]
	(infobox, statNow, statTot, statRequested) <- newInfoboxBrowser
	
	(filterbar, current, ent) <- newFilterBar filtered statNow filterBrowser
	empty <- checkButtonNewWithMnemonic "_empty"
	set empty [ toggleButtonActive := filterEmpty ]
	boxPackStart filterbar empty PackNatural spacingHalf
	on empty toggled $ do
		treeModelFilterRefilter filtered
		n <- treeModelIterNChildren filtered Nothing
		set statNow [ labelText := show n ]


	treeModelFilterSetVisibleFunc filtered $ \iter -> do
		GameServer{..}	<- treeModelGetRow raw iter
		s		<- readIORef current
		showEmpty	<- toggleButtonGetActive empty
		return $ (showEmpty || not (null players)) && (B.null s ||
			smartFilter s [
				  cleanedCase hostname
				, cleanedCase mapname
				, proto2string protocol
				, maybe "" cleanedCase gamemod
				])
			
	on view cursorChanged $ do
		(path, _) <- treeViewGetCursor view
		setServer False =<< getElementFS raw sorted filtered path

	on view rowActivated $ \path _ ->
		setServer True =<< getElementFS raw sorted filtered path
		
	scrollview <- scrolledWindowNew Nothing Nothing
	scrolledWindowSetPolicy scrollview PolicyNever PolicyAlways
	containerAdd scrollview view
	
	let updateF PollResult{..} = do
		listStoreClear raw
		treeViewColumnsAutosize view
		mapM_ (listStoreAppend raw) polled
		treeModelFilterRefilter filtered
		set statTot		[ labelText := show serversResponded ]
		set statRequested	[ labelText := show (serversRequested-serversResponded) ]
		n <- treeModelIterNChildren filtered Nothing
		set statNow 		[ labelText := show n ]
		
	box <- vBoxNew False 0
	boxPackStart box filterbar PackNatural spacing
	boxPackStart box scrollview PackGrow 0
	boxPackStart box infobox PackNatural 0
	
	return (box, updateF, ent)
	where
	showGame GameServer{..} = proto2string protocol ++ maybe "" (("-"++) . htmlEscape . unpackorig) gamemod
	showPlayers GameServer{..} = printf "%d / %2d" nplayers slots
	markupColumn colors f item =
		[ cellTextEllipsize := EllipsizeEnd
		, cellTextMarkup := Just (pangoPretty colors (f item)) ]
	intColumn f item = [ cellText := f item , cellXAlign := 1 ]
	simpleColumn f item = [ cellText := f item ]