Match.hs

module Macbeth.Wx.Match (
  wxMatch
) where

import Macbeth.Fics.FicsMessage
import Macbeth.Wx.GameType
import Macbeth.Wx.Utils

import Control.Concurrent.Chan
import Data.Map
import Data.Char
import Graphics.UI.WX hiding (color)
import Safe
import System.IO

data WxMatch = WxMatch {
  category :: Choice (),
  board :: Choice (),
  name :: TextCtrl (),
  time :: TextCtrl (),
  inc :: TextCtrl (),
  rated :: CheckBox (),
  color :: Choice ()
}

wxMatch :: Handle -> Bool -> Chan FicsMessage -> IO ()
wxMatch h isGuest chan = do
  f <- frameFixed [ text := "Create a match" ]
  p <- panel f []
  match <- matchInputs p isGuest
  set (category match) [on select ::= onSelectGameTypeCategory (board match)]

  b_ok  <- button p [text := "Match", on command := toString match >>= hPutStrLn h >> close f ]
  b_can <- button p [text := "Cancel", on command := close f]

  set f [ defaultButton := b_ok
        , layout := container p $ margin 10 $ column 10 [
               boxed "Game Type" (grid 15 15 [
                   [label "Category: ", hfill $ widget $ category match]
                 , [label "Board:" , hfill $ widget $ board match ]])
             , boxed "" (grid 15 15 [
                [ label "Player name:", hfill $ widget $ name match]
               ,[ label "Rated:", hfill $ widget $ rated match]
               ,[ label "Time:", hfill $ widget $ time match]
               ,[ label "Inc:", hfill $ widget $ inc match]
               ,[ label "Color:", hfill $ widget $ color match]
              ])
            , floatBottomRight $ row 5 [widget b_can, widget b_ok]]
        ]
  registerWxCloseEventListener f chan


matchInputs :: Panel () -> Bool -> IO WxMatch
matchInputs p isGuest = WxMatch
  <$> choice p [ items := fmap show (keys gameTypes)]
  <*> choice p []
  <*> textEntry p [ ]
  <*> textEntry p [ text := "5" ]
  <*> textEntry p [ text := "0" ]
  <*> checkBox p [ enabled := not isGuest ]
  <*> choice p [ tooltip := "color", sorted := False, items := ["Automatic", "White", "Black"]]


-- 4 match GuestXYZZ rated 5 0 white
toString:: WxMatch -> IO String
toString m = (("4 match " ++) . unwords) `fmap` sequence [
       get (name m) text
     , convertIsRated `fmap` get (rated m) enabled
     , get (time m) text
     , get (inc m) text
     , get (color m) selection >>= fmap convertColor . get (color m) . item
     , gameTypeSelectionToString <$> read `fmap` getDisplaySelection (category m)
                                 <*> readMay `fmap` getDisplaySelection (board m)]
    where
      convertIsRated r = if r then "rated" else "unrated"
      convertColor x = if x == "Automatic" then "" else fmap toLower x