showdown 0.5.2 → 0.5.3

raw patch · 2 files changed

+143/−2 lines, 2 files

Files

• Showdown.hs +141/−0
• showdown.cabal +2/−2

@@ -0,0 +1,141 @@+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)

@@ -1,5 +1,5 @@ name:                showdown-version:             0.5.2+version:             0.5.3 synopsis:            A simple gtk based Russian Roulette game. description:         A Russian Roulette game written in Haskell 		     Using GTK2HS and Glade.@@ -13,7 +13,7 @@ build-type:          Simple cabal-version:       >= 1.2 tested-with:         GHC == 6.10-extra-source-files:   README,LICENSE+extra-source-files:   README,LICENSE,Showdown.hs  executable:          showdown main-is:             Main.hs