module Macbeth.Wx.SoughtList ( wxSoughtList ) where import Macbeth.Fics.Api.Seek import Macbeth.Fics.Api.Game hiding (gameType, isRated) import Macbeth.Fics.FicsMessage import Macbeth.Wx.Utils import Paths import Control.Concurrent.STM import Control.Monad import Graphics.UI.WX hiding (when) import Graphics.UI.WXCore hiding (when) import System.IO import Data.List (elemIndex) data SoughtOpts = SoughtOpts { computerOffers :: MenuItem () , unregisteredPlayers :: MenuItem () , unratedOffers :: MenuItem () , ratedOffers :: MenuItem () } wxSoughtList :: Panel () -> Handle -> IO (ListCtrl (), FicsMessage -> IO ()) wxSoughtList slp h = do sl <- listCtrl slp [columns := [ ("#", AlignLeft, -1) , ("Handle", AlignLeft, -1) , ("Rating", AlignLeft, -1) , ("Time (start inc.)", AlignRight, -1) , ("Type", AlignRight, -1)] ] set sl [on listEvent := onSeekListEvent sl h] listCtrlSetColumnWidths sl 100 ctxMenu <- menuPane [] soughtOpts <- getSoughtOpts ctxMenu vSoughtList <- newTVarIO ([] :: [Seek]) set (computerOffers soughtOpts) [on command := filterSoughtList sl soughtOpts vSoughtList] set (unregisteredPlayers soughtOpts) [on command := filterSoughtList sl soughtOpts vSoughtList] set (unratedOffers soughtOpts) [on command := filterSoughtList sl soughtOpts vSoughtList] set (ratedOffers soughtOpts) [on command := filterSoughtList sl soughtOpts vSoughtList] listItemRightClickEvent sl (\evt -> do pt <- listEventGetPoint evt menuPopup ctxMenu pt sl) imagePaths <- mapM getDataFileName imageFiles images <- imageListFromFiles (sz 16 16) imagePaths listCtrlAssignImageList sl images wxIMAGE_LIST_SMALL let handler cmd = case cmd of NewSeek seek -> do atomically $ modifyTVar vSoughtList (\sl -> sl ++ [seek]) showSeek' <- showSeek soughtOpts when (showSeek' seek) $ addSeek sl seek ClearSeek -> itemsDelete sl RemoveSeeks gameIds -> do seeks <- get sl items sequence_ $ fmap (deleteSeek sl . findSeekIdx seeks) gameIds _ -> return () return (sl, handler) imageNames = ["fa-user", "fa-desktop"] imageFiles = map (\name -> "icons/" ++ name ++ ".gif") imageNames addSeek :: ListCtrl () -> Seek -> IO () addSeek l seek = do count <- listCtrlGetItemCount l item <- listItemCreate listItemSetId item count --when (Computer `elem` titles seek) $ listItemSetBackgroundColour item (colorRGB 125 149 184) listItemSetImage item $ if Computer `elem` titles seek then 1 else 0 listCtrlInsertItem l item mapM_ (\(column,txt) -> listCtrlSetItem l count column txt (-1)) (zip [0..] (toList seek)) showSeek :: SoughtOpts -> IO (Seek -> Bool) showSeek opts = do computerOffers' <- get (computerOffers opts) checked unregisteredPlayers' <- get (unregisteredPlayers opts) checked unratedOffers' <- get (unratedOffers opts) checked ratedOffers' <- get (ratedOffers opts) checked return $ \s -> (gameType s `elem` [Untimed, Standard, Blitz, Lightning]) && ((Computer `elem` titles s) .>. computerOffers') && ((Unregistered `elem` titles s) .>. unregisteredPlayers') && (isRated s .>. ratedOffers') && (not (isRated s) .>. unratedOffers') (.>.) :: Bool -> Bool -> Bool (.>.) p q = (not p) || q filterSoughtList :: ListCtrl () -> SoughtOpts -> TVar [Seek] -> IO () filterSoughtList sl opts vSoughtList = do showSeek' <- showSeek opts soughts <- readTVarIO vSoughtList listCtrlDeleteAllItems sl mapM_ (\s -> when (showSeek' s) $ addSeek sl s) soughts onSeekListEvent :: ListCtrl() -> Handle -> EventList -> IO () onSeekListEvent sl h evt = case evt of ListItemActivated idx -> listCtrlGetItemText sl idx >>= hPutStrLn h . ("4 play " ++) _ -> return () findSeekIdx :: [[String]] -> Int -> Maybe Int findSeekIdx seeks gameId = elemIndex gameId $ fmap (read . (!! 0)) seeks deleteSeek :: ListCtrl () -> Maybe Int -> IO () deleteSeek sl (Just id) = itemDelete sl id deleteSeek _ _ = return () getSoughtOpts :: Menu () -> IO SoughtOpts getSoughtOpts ctxMenu = SoughtOpts <$> menuItem ctxMenu [ text := "Show computer offers", checkable := True, checked := True] <*> menuItem ctxMenu [ text := "Show unregistered players", checkable := True, checked := True] <*> menuItem ctxMenu [ text := "Show unrated offers", checkable := True, checked := True] <*> menuItem ctxMenu [ text := "Show rated offers", checkable := True, checked := True] toList :: Seek -> [String] toList (Seek id name _ rating time inc isRated gameType _ _) = [show id, name, show rating, show time ++ " " ++ show inc, show gameType ++ " " ++ showIsRated isRated] where showIsRated True = "rated" showIsRated False = "unrated"