showdown-0.5.3: Showdown.hs

module Showdown where

import Graphics.UI.Gtk
import Graphics.UI.Gtk.Glade
import Graphics.UI.Gtk.Gdk.Events
import Control.Monad
import Data.IORef
import System.Random

data State = State {
      p1    :: String
    , p2    :: String
    , ptext :: String
    , cyls  :: Int
    , curp  :: Int
    , mnum  :: Int } deriving (Show)

data Player = Player1 | Player2
            deriving (Eq)

main :: FilePath -> IO ()
main gladepath = do
  initGUI
  -- Create inital game state
  st <- newIORef (State "" "" "" 0 0 0)
  -- Get handles to all needed widgets from Glade file
  Just xml <- xmlNew gladepath
  mw     <- xmlGetWidget xml castToWindow "mainWindow"
  sw     <- xmlGetWidget xml castToWindow "window2"
  mb     <- xmlGetWidget xml castToButton "fireButton"
  ng     <- xmlGetWidget xml castToButton "nbutton"
  mv     <- xmlGetWidget xml castToTextView "textview1"
  but    <- xmlGetWidget xml castToButton "button1"
  ab     <- xmlGetWidget xml castToAboutDialog "aboutdialog1"
  menu   <- xmlGetWidget xml castToMenuItem "menuitem3"
  about  <- xmlGetWidget xml castToMenuItem "imagemenuitem10"
  quitb  <- xmlGetWidget xml castToMenuItem "menuitem3"
  p1name <- xmlGetWidget xml castToEntry "entry1"
  p2name <- xmlGetWidget xml castToEntry "entry2"
  spin   <- xmlGetWidget xml castToSpinButton "spinbutton1"
  sett   <- xmlGetWidget xml castToMenuItem "menuitem2"
  p1lab  <- xmlGetWidget xml castToLabel "label4"
  p2lab  <- xmlGetWidget xml castToLabel "label5"
  cylab  <- xmlGetWidget xml castToLabel "label6"
  -- Handle events and such
  buff <- textViewGetBuffer mv
  onActivateLeaf quitb mainQuit
  onKeyPress mv $ \(Key { eventKeyName = name }) -> if name == "Return"
                                                    then fireButton st sw buff cylab mv >>
                                                         return True
                                                    else return False
  onResponse ab $ \resp -> 
     case resp of
        ResponseClose -> widgetHide ab
        _             -> widgetHide ab
  onActivateLeaf about $ widgetShow ab
  onActivateLeaf sett  $ widgetShowAll sw
  onDelete sw $ \_ -> widgetHide sw >> return True
  onClicked but $ 
            initalize sw p1name p2name spin st p1lab p2lab cylab buff
  onClicked ng $ widgetShowAll sw
  onDelete ab $ \_ -> widgetHide ab >> return True
  onClicked mb $ fireButton st sw buff cylab mv
  onActivateLeaf menu $ widgetDestroy mw
  onDestroy mw mainQuit
  widgetShowAll mw
  mainGUI

initalize :: Window  -> Entry -> Entry -> SpinButton
          -> IORef State -> Label -> Label -> Label 
          -> TextBuffer -> IO ()
-- Initalize the game
initalize w p1n p2n sb st p1l p2l cyl buf = do
  widgetHide w
  p1   <- entryGetText p1n
  p2   <- entryGetText p2n
  cyls <- liftM truncate $ get sb spinButtonValue
  magn <- randomRIO (1,cyls)
  writeIORef st $ State p1 p2 "" cyls 0 magn
  updateLabels p1 p2 cyls p1l p2l cyl
  textBufferSetText buf ""

fireButton :: IORef State 
            -> Window 
            -> TextBuffer 
            -> Label
            -> TextView
            -> IO ()
-- Guts of the program
fireButton st sw buff cylab tv= do
  state <- readIORef st
  if (cyls state == 0 || cyls state == ((mnum state) -1)) 
   then widgetShowAll sw
   else do
     textBufferSetText buff $ 
                       game (ptext state) (cyls state) (mnum state) (currentP  (p1 state) (p2 state) (curp state))
     si <- textBufferGetStartIter buff
     ei <- textBufferGetEndIter buff
     text <- textBufferGetText buff si ei False
     textViewScrollToIter tv ei 0 Nothing
     writeIORef st $ state { cyls = ((cyls state) -1), curp = (curp state + 1), ptext = text }
     labelSetText cylab $ "Cylinders remaining: " ++ show ((cyls state) -1)

-- Figures out the current player based on whether or not
-- n is even.
currentP :: String -> String -> Int -> String
currentP p1 p2 n = if (p1OrP2 n == Player1) then p1 else p2

p1OrP2 :: Int -> Player
p1OrP2 n = if (even n) then Player1 else Player2

-- Returns the game message appropriate for the current
-- round.
game :: String -> Int -> Int -> String -> String
game pt cyl mn pname | cyl == mn  = pt        ++
                                    "Bang! "  ++ 
                                    pname     ++ " bit the bullet!\n"
                     | otherwise  = pt        ++
                                    "Click! " ++ 
                                    pname     ++ " lives another round!\n"

--Updates a bunch-o-labels
updateLabels :: String 
             -> String 
             -> Int 
             -> Label 
             -> Label  
             -> Label 
             -> IO ()

updateLabels p1 p2 cyl p1l p2l cyll = do
  setPlayer 1 p1 p1l
  setPlayer 2 p2 p2l
  labelSetText cyll $ "Cylinders Remaining: " ++ (show cyl)

-- Sets the label for each player
setPlayer :: Int -> String -> Label -> IO ()
setPlayer pn str lab
              | pn == 1   = setlab "Player 1: "
              | otherwise = setlab "Player 2: "
              where setlab x = labelSetText lab (x ++ str)