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)