boring-game (empty) → 0.1.0.0

raw patch · 10 files changed

+282/−0 lines, 10 filesdep +basedep +boring-gamedep +glosssetup-changed

Dependencies added: base, boring-game, gloss

Files

• LICENSE +30/−0
• README.md +1/−0
• Setup.hs +2/−0
• app/Main.hs +45/−0
• boring-game.cabal +43/−0
• src/Animation.hs +27/−0
• src/Collision.hs +42/−0
• src/EventHandler.hs +24/−0
• src/Pong.hs +66/−0
• test/Spec.hs +2/−0

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,1 @@+Just a boring game !

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,45 @@+{-|+Module      : Main+Description : Test the game+Copyright   : (c) Truong Dung, 2017+License     : GPL-3+Maintainer  : checkraiser11@gmail.com+Stability   : experimental+Portability : POSIX+-}+module Main(main) where++import Graphics.Gloss++import Pong (PongGame, render, initialState)+import Animation(moveBall)+import Collision(wallBounce2)+import EventHandler(handleKeys)++width, height, offset :: Int+width = 300+height = 300+offset = 10++window :: Display+window = InWindow "Nice Window" (width, height) (offset, offset)++background :: Color+background = black++main1 :: IO ()+main1 = animate window background frame+  where+    frame :: Float -> Picture+    frame seconds = render $ moveBall seconds initialState++-- | Number of frames to show per second.+fps :: Int+fps = 120++main :: IO ()+main = play window background fps initialState render handleKeys update++-- | Update the game by moving the ball and bouncing off walls.+update :: Float -> PongGame -> PongGame+update seconds = (wallBounce2 width) . moveBall seconds

@@ -0,0 +1,43 @@+name:                boring-game+version:             0.1.0.0+synopsis:            An educational game+description:         Using Gloss to build game in Haskell +homepage:            https://github.com/checkraiser/boring-game#readme+license:             BSD3+license-file:        LICENSE+author:              Author name here+maintainer:          example@example.com+copyright:           2017 Author name here+category:            Web+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Pong, Animation, Collision, EventHandler+  build-depends:       base >= 4.7 && < 5                     +                     , gloss+  default-language:    Haskell2010++executable boring-game-exe+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , boring-game+                     , gloss+  default-language:    Haskell2010++test-suite boring-game-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , boring-game+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/checkraiser/boring-game

@@ -0,0 +1,27 @@+{-|+Module      : Animation+Description : Move the ball+Copyright   : (c) Truong Dung, 2017+License     : GPL-3+Maintainer  : checkraiser11@gmail.com+Stability   : experimental+Portability : POSIX+-}+module Animation(moveBall) where ++import Pong(PongGame, ballLoc, ballVel)++-- | Update the ball position using its current velocity.+moveBall :: Float -- ^ The number of seconds since last update+         -> PongGame -- ^ The initial game state+         -> PongGame -- ^ A new game state with an updated ball position++moveBall seconds game = game { ballLoc = (x', y') }         +  where +    -- Old locations and velocities+    (x, y) = ballLoc game +    (vx, vy) = ballVel game +    -- New locations.+    x' = x + vx * seconds+    y' = y + vy * seconds+

@@ -0,0 +1,42 @@+{-|+Module      : Collision+Description : Collision detection+Copyright   : (c) Truong Dung, 2017+License     : GPL-3+Maintainer  : checkraiser11@gmail.com+Stability   : experimental+Portability : POSIX+-}+module Collision(wallBounce2) where ++import Pong(PongGame, ballLoc, ballVel)++-- | Detect a collision with a paddle. Upon collisions,+-- change the velocity of the ball to bounce it off the paddle.+-- paddleBounce :: PongGame -> PongGame+wallBounce2 :: Int -> PongGame -> PongGame+wallBounce2 width game = game { ballVel = (vx, vy') }+  where+    -- Radius. Use the same thing as in `render`.+    radius = 10++    -- The old velocities.+    (vx, vy) = ballVel game++    vy' = if wallCollision2 width (ballLoc game) radius+          then+             -- Update the velocity.+             -vy+           else+            -- Do nothing. Return the old velocity.+            vy++type Radius = Float +type Position = (Float, Float)++-- | Given position and radius of the ball, return whether a collision occurred.+wallCollision2 :: Int -> Position -> Radius -> Bool +wallCollision2 width (_, y) radius = topCollision || bottomCollision+  where+    topCollision    = y - radius <= -fromIntegral width / 2 +    bottomCollision = y + radius >=  fromIntegral width / 2

@@ -0,0 +1,24 @@+{-|+Module      : EventHandler+Description : Handle the input events+Copyright   : (c) Truong Dung, 2017+License     : GPL-3+Maintainer  : checkraiser11@gmail.com+Stability   : experimental+Portability : POSIX+-}+module EventHandler(handleKeys) where ++import Graphics.Gloss+import Graphics.Gloss.Interface.Pure.Game+import Pong(PongGame, ballLoc)++-- | Respond to key events.+handleKeys :: Event -> PongGame -> PongGame++-- For an 's' keypress, reset the ball to the center.+handleKeys (EventKey (Char 's') _ _ _) game =+  game { ballLoc = (0, 0) }++-- Do nothing for all other events.+handleKeys _ game = game

@@ -0,0 +1,66 @@+{-|+Module      : Pong+Description : GameState management+Copyright   : (c) Truong Dung, 2017+License     : GPL-3+Maintainer  : checkraiser11@gmail.com+Stability   : experimental+Portability : POSIX+-}+module Pong(+  PongGame,+  ballLoc,+  ballVel,+  render, +  initialState+) where++import Graphics.Gloss+-- | Data describing the state of the pong game+data PongGame = Game+  { ballLoc :: (Float, Float) -- ^ Pong ball (x, y) location+  , ballVel :: (Float, Float) -- ^ Pong ball (x, y) velocity+  , player1 :: Float -- ^ Left player paddle height+  , player2 :: Float -- ^ Right player+  } deriving Show+++-- | The initial state for the game of Pong+initialState :: PongGame+initialState = Game+  { ballLoc = (-10, 30)+  , ballVel = (1, -3)+  , player1 = 40+  , player2 = -80+  }++-- | Convert a game state into a picture+render :: PongGame -- ^ The game state to render.+          -> Picture -- ^ A picture of this game state.+render game =+  pictures [ball, walls,+          mkPaddle rose 120 $ player1 game,+          mkPaddle orange (-120) $ player2 game]++  where+    -- the pong ball.+    ball = uncurry translate (ballLoc game) $ color ballColor $ circleSolid 10+    ballColor = dark red++    -- the bottom and top walls.+    wall :: Float -> Picture+    wall offset = translate 0 offset $+                    color wallColor $+                      rectangleSolid 270 10++    wallColor = greyN 0.5+    walls = pictures [wall 150, wall (-150)]++    -- make a paddle of a given border and vertical offset.+    mkPaddle :: Color -> Float -> Float -> Picture+    mkPaddle col x y = pictures+      [ translate x y $ color col $ rectangleSolid 26 86+      , translate x y $ color paddleColor $ rectangleSolid 20 80+      ]++    paddleColor = light $ light blue

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"