Challenge.hs

{-# LANGUAGE LambdaCase #-}

module Macbeth.Wx.Challenge (
  wxChallenge
) where

import Macbeth.Fics.Api.Challenge
import Macbeth.Fics.FicsMessage
import Macbeth.Wx.Utils

import Control.Concurrent
import Graphics.UI.WX
import Graphics.UI.WXCore
import System.IO


wxChallenge :: Handle -> Challenge -> Chan FicsMessage  -> IO ()
wxChallenge h c chan = do
  vCmd <- newEmptyMVar

  f <- frame []
  p <- panel f []

  b_accept  <- button p [text := "Accept", on command := hPutStrLn h "5 accept" >> close f]
  b_decline <- button p [text := "Decline", on command := hPutStrLn h "5 decline" >> close f]
  st_params <- staticText p [ text := displayChallenge c
                            , fontFace := "Avenir Next Medium"
                            , fontSize := 16
                            , fontWeight := WeightBold]

  set f [ defaultButton := b_accept
        , layout := container p $ margin 10 $
            column 5 [boxed "You received a challenge." (
              grid 5 5 [
                [ hfill $ widget st_params]]
            )
            , floatBottomRight $ row 5 [widget b_accept, widget b_decline]]
        ]

  evtHandlerOnMenuCommand f eventId $ takeMVar vCmd >>= \case

      MatchRequested c' -> when (isUpdate c c') $ close f

      WxClose -> close f

      _ -> return ()

  threadId <- forkIO $ eventLoop eventId chan vCmd f
  windowOnDestroy f $ killThread threadId


isUpdate :: Challenge -> Challenge -> Bool
isUpdate c c' = (nameW c == nameW c') && (nameB c == nameB c')

eventId = wxID_HIGHEST + 1