85 lines
3.2 KiB
Haskell
85 lines
3.2 KiB
Haskell
|
import qualified Graphics.Gloss.Interface.Pure.Game as Gloss
|
||
|
|
import qualified Graphics.Gloss.Data.Bitmap as Bitmap
|
||
|
|
import qualified Data.Map as Map
|
||
|
|
import Data.List
|
||
|
|
import Data.Maybe
|
||
|
|
import System.Random (randomRIO)
|
||
|
|
|
||
|
|
data Move = Paper | Rock | Scissors | Tie deriving (Eq, Ord, Show)
|
||
|
|
--data Result = Computer | Human | Tie deriving (Eq, Ord, Show)
|
||
|
|
|
||
|
|
data Game = Game {
|
||
|
|
human :: Maybe Move,
|
||
|
|
computer :: Move,
|
||
|
|
humanScore :: Int,
|
||
|
|
computerScore :: Int
|
||
|
|
}
|
||
|
|
|
||
|
|
beats :: Move -> Move
|
||
|
|
beats move = case move of
|
||
|
|
Paper -> Scissors
|
||
|
|
Rock -> Paper
|
||
|
|
Scissors -> Rock
|
||
|
|
|
||
|
|
|
||
|
|
score :: Move -> Move -> Move
|
||
|
|
score this_move other_move
|
||
|
|
| this_move == beats other_move = this_move
|
||
|
|
| this_move == other_move = Tie
|
||
|
|
| otherwise = other_move
|
||
|
|
|
||
|
|
score' (Game h@(Just this_move) other_move hs cs)
|
||
|
|
| this_move == beats other_move = this_move
|
||
|
|
| this_move == other_move = Tie
|
||
|
|
| otherwise = other_move
|
||
|
|
|
||
|
|
updateScore (Game h@(Just this_move) other_move hs cs)
|
||
|
|
| this_move == beats other_move = Game h other_move (hs+1) cs
|
||
|
|
| this_move == other_move = Game h other_move hs cs
|
||
|
|
| otherwise = Game h other_move hs (cs+1)
|
||
|
|
|
||
|
|
--Define a random choice
|
||
|
|
pick :: [a] -> IO a
|
||
|
|
pick xs = randomRIO (0, length xs -1 ) >>= return . (xs !!)
|
||
|
|
|
||
|
|
whatdoescomputersay = pick [Rock, Paper, Scissors]
|
||
|
|
|
||
|
|
handleEvent (Gloss.EventKey (Gloss.Char keypress) Gloss.Down _ (_, _)) game@(Game h c hs cs)
|
||
|
|
| keypress == 'p' = updateScore (Game (Just Paper) c hs cs)
|
||
|
|
| keypress == 'r' = updateScore (Game (Just Rock) c hs cs)
|
||
|
|
| keypress == 's' = updateScore (Game (Just Scissors) c hs cs)
|
||
|
|
| otherwise = Game (Nothing) c hs cs
|
||
|
|
|
||
|
|
handleEvent _ game = game
|
||
|
|
|
||
|
|
main = do
|
||
|
|
let possibleMoves = [Paper, Rock, Scissors]
|
||
|
|
computer <- pick possibleMoves
|
||
|
|
|
||
|
|
rockwin <- Bitmap.loadBMP "rockwins.bmp"
|
||
|
|
paperwin <- Bitmap.loadBMP "paperwins.bmp"
|
||
|
|
scissorswin <- Bitmap.loadBMP "scissorswin.bmp"
|
||
|
|
tie <- Bitmap.loadBMP "tie.bmp"
|
||
|
|
rockPicture <- Bitmap.loadBMP "iconRock.bmp"
|
||
|
|
scissorsPicture <- Bitmap.loadBMP "iconScissors.bmp"
|
||
|
|
paperPicture <- Bitmap.loadBMP "iconPaper.bmp"
|
||
|
|
yourchoice <- Bitmap.loadBMP "yourchoice.bmp"
|
||
|
|
computerchoice <- Bitmap.loadBMP "computerchoice.bmp"
|
||
|
|
|
||
|
|
let userUI = Map.fromList [(Paper, paperPicture), (Scissors, scissorsPicture), (Rock, rockPicture)]
|
||
|
|
let results = Map.fromList [(Rock, rockwin), (Paper, paperwin), (Scissors, scissorswin), (Tie, tie)]
|
||
|
|
let all_pictures = [(Gloss.translate (-275) 0 rockPicture), (Gloss.translate 0 0 paperPicture), (Gloss.Translate 275 0 scissorsPicture)]
|
||
|
|
|
||
|
|
let display game@(Game human computer humanScore computerScore) = if human == Nothing then Gloss.Pictures ([Gloss.Translate (-550) (300) (Gloss.Color Gloss.white (Gloss.Text "Press p, r, or s!"))]++all_pictures) else Gloss.Pictures [results Map.! (score' game), Gloss.Translate (-500) 0 (userUI Map.! fromJust (human)), Gloss.Translate 500 0 (userUI Map.! computer), Gloss.Translate (-500) 250 yourchoice, Gloss.Translate 500 250 computerchoice]
|
||
|
|
|
||
|
|
let initialGame = Game (Nothing) computer 0 0
|
||
|
|
|
||
|
|
Gloss.play
|
||
|
|
(Gloss.InWindow "Rock Paper Scissors" (1920,1080) (0,0))
|
||
|
|
Gloss.black --background color
|
||
|
|
10
|
||
|
|
initialGame
|
||
|
|
display
|
||
|
|
handleEvent
|
||
|
|
(\f g -> g)
|