module Macbeth.Wx.Seek ( wxSeek , toString , SeekInfo (..) ) where import Macbeth.Fics.Api.Api import Macbeth.Fics.FicsMessage import Macbeth.Wx.GameType import Macbeth.Wx.Utils import Control.Concurrent.Chan import Data.Map (keys) import Graphics.UI.WX hiding (color) import Safe import System.IO -- seek [time inc] [rated|unrated] [white|black] [crazyhouse] [suicide] [wild #] [auto|manual] [formula] [rating-range] data WxSeek = WxSeek { category :: Choice () , board :: Choice () , time :: TextCtrl () , inc :: TextCtrl () , rated :: CheckBox () , color :: Choice () , manual :: CheckBox () --, formula :: CheckBox () , ratingFrom :: TextCtrl () , ratingTo :: TextCtrl () } data SeekInfo = SeekInfo { _category :: Category , _board :: Maybe Board , _time :: Int , _inc :: Int , _rated :: Bool , _color :: Maybe PColor , _manual :: Bool -- , _formula :: Bool , _ratingFrom :: Int , _ratingTo :: Int } wxSeek :: Handle -> Bool -> Chan FicsMessage -> IO () wxSeek h isGuest chan = do f <- frameFixed [ text := "Seek a match" ] p <- panel f [] match <- matchInputs p isGuest set (category match) [on select ::= onSelectGameTypeCategory (board match)] b_ok <- button p [text := "Create", on command := readSeek match >>= hPutStrLn h . ("4 seek " ++) . toString >> close f ] b_can <- button p [text := "Cancel", on command := close f] set f [ defaultButton := b_ok , layout := container p $ margin 10 $ column 15 [ boxed "Game Type" (grid 15 15 [ [label "Category: ", hfill $ widget $ category match, label "Board:", hfill $ widget $ board match ] ]), boxed "" (grid 15 15 [ [ label "Time [min.]:", hfill $ widget $ time match, label "Inc [sec.]:", hfill $ widget $ inc match] , [ label "Rated:", hfill $ widget $ rated match, label "Color:", hfill $ widget $ color match] , [ label "Manual accept:", hfill $ widget $ manual match, empty, empty] , [ label "Rating from", hfill $ widget $ ratingFrom match, label "to", hfill $ widget $ ratingTo match] ]) , floatBottomRight $ row 5 [widget b_can, widget b_ok]] ] registerWxCloseEventListener f chan -- seek [time inc] [rated|unrated] [white|black] [crazyhouse] [suicide] -- [wild #] [auto|manual] [formula] [rating-range] toString :: SeekInfo -> String toString m = unwords $ filter (/= "") [ show $ _time m , show $ _inc m , convertIsRated $ _rated m , maybe "" convertColor (_color m) , gameTypeSelectionToString (_category m) (_board m) , convertAutoManual (_manual m) , convertRatingRange (_ratingFrom m) (_ratingTo m)] where convertIsRated r = if r then "r" else "u" convertColor White = "w" convertColor Black = "b" convertRatingRange from to = show from ++ "-" ++ show to convertAutoManual isManual = if isManual then "m" else "a" readSeek :: WxSeek -> IO SeekInfo readSeek m = SeekInfo <$> read `fmap` getDisplaySelection (category m) <*> readMay `fmap` getDisplaySelection (board m) <*> read `fmap` get (time m) text <*> read `fmap` get (inc m) text <*> get (rated m) checked <*> convertColor `fmap` getDisplaySelection (color m) <*> get (manual m) checked <*> read `fmap` get (ratingFrom m) text <*> read `fmap` get (ratingTo m) text where convertColor "Automatic" = Nothing convertColor c = read c matchInputs :: Panel () -> Bool -> IO WxSeek matchInputs p isGuest = WxSeek <$> choice p [items := fmap show (filter (/= Bughouse) $ keys gameTypes)] <*> choice p [] <*> textEntry p [ text := "5"] <*> textEntry p [ text := "0"] <*> checkBox p [ enabled := not isGuest ] <*> choice p [tooltip := "color", sorted := False, items := ["Automatic", "White", "Black"]] <*> checkBox p [] <*> textEntry p [ text := "0"] <*> textEntry p [ text := "9999"]