diff --git a/Collision.hs b/Collision.hs new file mode 100644 --- /dev/null +++ b/Collision.hs @@ -0,0 +1,77 @@ +{- + The MIT License + + Copyright (c) 2010 Korcan Hussein + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. +-} +{-# LANGUAGE MultiParamTypeClasses #-} +module Collision where + +import Vector2 + +class Collision a b where + intersect :: a -> b -> Bool + +newtype Bounds = Bounds { sides :: (Float,Float,Float,Float) } + +instance Collision Bounds Bounds where + Bounds (ax, ay, aw, ah) `intersect` Bounds (bx, by, bw, bh) + | t1 > bw || (-t1) > aw = False + | t2 > bh || (-t2) > ah = False + | otherwise = True + where t1 = ax - bx + t2 = ay - by + +-- Dynamic seperating-axis test +intersectMoving :: Bounds -> Bounds -> Vector2f -> Vector2f -> Maybe (Float,Float) +intersectMoving a@(Bounds (ax, ay, aw, ah)) b@(Bounds (bx, by, bw, bh)) va vb + | intersect a b = Just (0,0) + | otherwise = do + let v = vb `sub` va + -- test x-axis + (t1, t2) <- test (fst v) 0 1 ax maxAx bx maxBx + -- test y-axis + test (snd v) t1 t2 ay maxAy by maxBy + + where maxAx = ax + aw + maxAy = ay + ah + maxBx = bx + bw + maxBy = by + bh + test vi tfirst tlast aMin aMax bMin bMax = + case test1 vi tfirst tlast aMin aMax bMin bMax of + Just (t1, t2) -> if t1 > t2 then Nothing else Just (t1,t2) + _ -> Nothing + test1 vi tfirst tlast aMin aMax bMin bMax + | vi < 0.0 = if bMax < aMin + then Nothing -- no-interesection will occur + else + let t1 = if aMax < bMin then max ((aMax - bMin) / vi) tfirst else tfirst + t2 = if bMax > aMin then min ((aMin - bMax) / vi) tlast else tlast + in Just (t1,t2) + | vi > 0.0 = if bMin > aMax + then Nothing -- no-interesection will occur + else + let t1 = if bMax < aMin then max ((aMin - bMax) / vi) tfirst else tfirst + t2 = if aMax > bMin then min ((aMax - bMin) / vi) tlast else tlast + in Just (t1,t2) + | otherwise = -- zero component + if bMax < aMin || bMin > aMax + then Nothing -- no-interesection + else Just (max 0.0 tfirst, min 1.0 tlast) diff --git a/Consts.hs b/Consts.hs new file mode 100644 --- /dev/null +++ b/Consts.hs @@ -0,0 +1,49 @@ +----------------------------------------------------------------------------- +-- +-- Module : Consts +-- Copyright : Copyright (c) 2010 Korcan Hussein +-- License : MIT +-- +-- Maintainer : korcan_h@hotmail.com +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- +module Consts where + +import Graphics.UI.SDL.Color + +screenBpp :: Int +screenBpp = 32 + +screenWidth, screenHeight :: Float +screenWidth = 640 +screenHeight = 480 + + +halfHeight, halfWidth :: Float +halfHeight = screenHeight / 2 +halfWidth = screenWidth / 2 + +paddleW, paddleH, ballW, ballH :: Float +paddleW = 22 +paddleH = 96 +ballW = 8 +ballH = 8 + +paddleVel :: Float +paddleVel = 400 + +secs :: Float +secs = 1.0 / 1000.0 + +textColor :: Color +textColor = Color 0xFF 0xFF 0xFF + +degToRad :: Float +degToRad = pi / 180 + +ballVel :: Float +ballVel = 350 diff --git a/Draw.hs b/Draw.hs new file mode 100644 --- /dev/null +++ b/Draw.hs @@ -0,0 +1,150 @@ +----------------------------------------------------------------------------- +-- +-- Module : Draw +-- Copyright : Copyright (c) 2010 Korcan Hussein +-- License : MIT +-- +-- Maintainer : korcan_h@hotmail.com +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- +-- +-- The MIT License +-- +-- Copyright (c) 2010 Korcan Hussein. +-- +-- Permission is hereby granted, free of charge, to any person obtaining a copy +-- of this software and associated documentation files (the "Software"), to deal +-- in the Software without restriction, including without limitation the rights +-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +-- copies of the Software, and to permit persons to whom the Software is +-- furnished to do so, subject to the following conditions: +-- +-- The above copyright notice and this permission notice shall be included in +-- all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +-- THE SOFTWARE. +-- +{-# LANGUAGE FlexibleContexts #-} +module Draw ( + render, + renderWin, + renderPaused +) where + +import Prelude hiding (id, (.), mod, init) +import Control.Category + +import Control.Monad.Reader +import Control.Monad.Trans + +import Data.Record.Label + +import Graphics.UI.SDL hiding (flip) +import qualified Graphics.UI.SDL as SDL (flip) + +import Graphics.UI.SDL.TTF + +import Labels +import Surface +import GameState +import GameEnv +import Consts + +render :: GameEnv () +render = do + screen <- askM screen + liftIO $ clear screen 0x00 0x00 0x00 + + drawNet + drawPaddle 0 + drawPaddle 1 + drawBall + + drawScore + + liftIO $ SDL.flip screen + +renderWin :: GameEnv () +renderWin = do + screen <- askM screen + liftIO $ clear screen 0x00 0x00 0x00 + + drawNet + drawPaddle 0 + drawPaddle 1 + drawScore + + liftIO $ SDL.flip screen + +renderPaused :: GameEnv () +renderPaused = do + screen <- askM screen + liftIO $ clear screen 0x00 0x00 0x00 + + --drawNet + drawPaddle 0 + drawPaddle 1 + drawBall + drawScore + drawPaused + liftIO $ SDL.flip screen + +blitScreen :: (MonadIO m, MonadReader GameConfig m) => Int -> Int -> Surface -> Maybe Rect -> m () +blitScreen x y s r = do + screen <- askM screen + applySurface' x y s screen r +{-# INLINE blitScreen #-} + +drawNet :: GameEnv () +drawNet = do + dst <- askM screen + liftIO $ drawLine dst (x,0) (screenHeight'-1) 2 Vertical $ Pixel 0xFFFFFFFF + where screenHeight' = truncate screenHeight + screenWidth' = truncate screenWidth + x = screenWidth' `div` 2 + + +drawPaddle :: Int -> GameEnv () +drawPaddle paddleIdx = do + ps <- askM paddleSprite + (px,py) <- getM (pPos . paddlel) + blitScreen (truncate px) (truncate py) ps Nothing + where paddlel = if paddleIdx == 0 then paddle1 else paddle2 + +drawBall :: GameEnv () +drawBall = do + bs <- askM ballSprite + (bx,by) <- getM (pos . ball) + blitScreen (truncate bx) (truncate by) bs Nothing + +drawScore :: GameEnv () +drawScore = do + f <- askM font + p1c <- liftM show $ getM $ player1Count . stats + p2c <- liftM show $ getM $ player2Count . stats + + p1Score <- liftIO $ renderTextSolid f p1c textColor + p2Score <- liftIO $ renderTextSolid f p2c textColor + + blitScreen (halfWidth' - 50 - surfaceGetWidth p1Score) 20 p1Score Nothing + blitScreen (halfWidth' + 50) 20 p2Score Nothing + where + halfWidth' = truncate halfWidth + +drawPaused :: GameEnv () +drawPaused = do + pSprite <- askM pausedSprite + blitScreen (halfWidth' - surfaceGetWidth pSprite `div` 2) (halfHeight' - surfaceGetHeight pSprite `div` 2) pSprite Nothing + where + halfWidth' = truncate halfWidth + halfHeight' = truncate halfHeight diff --git a/GameEnv.hs b/GameEnv.hs new file mode 100644 --- /dev/null +++ b/GameEnv.hs @@ -0,0 +1,41 @@ +{- + The MIT License + + Copyright (c) 2010 Korcan Hussein. + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. +-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module GameEnv +( + GameEnv(), + runGame, +) where + +import Control.Monad.State +import Control.Monad.Reader + +import GameState + +type GameState = StateT GameData IO +newtype GameEnv a = GameEnv { runEnv :: ReaderT GameConfig GameState a } + deriving (Monad, MonadIO, MonadReader GameConfig, MonadState GameData) + +runGame :: GameConfig -> GameData -> GameEnv a -> IO (a, GameData) +runGame config state (GameEnv env) = (runStateT . runReaderT env) config state diff --git a/GameState.hs b/GameState.hs new file mode 100644 --- /dev/null +++ b/GameState.hs @@ -0,0 +1,133 @@ +{- + The MIT License + + Copyright (c) 2010 Korcan Hussein. + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. +-} +{-# LANGUAGE TemplateHaskell, TypeOperators, FlexibleContexts #-} +module GameState where + +import Prelude hiding (id, (.), mod) + +import System.Random + +import Control.Category +import Control.Monad.Reader +import Control.Monad.State hiding (get) +--import qualified Control.Monad.State as MState (get,put) + +import Data.Word +import Data.Record.Label + +import Graphics.UI.SDL (Surface) +import Graphics.UI.SDL.TTF (Font) +import Graphics.UI.SDL.Mixer (Chunk) + +import Labels +import Vector2 +import Collision +import Timer +import Consts + +--type Vector2f = (Float, Float) +data Player = Player1 | Player2 + deriving (Eq, Show) + +data GameLoopState = + Win Player + | Init Player + | Play + | Paused + +data Ball = Ball { + _pos :: Vector2f, + _vel :: Vector2f +} deriving (Eq, Show) + +data Paddle = Paddle { + _pPos :: Vector2f, + _yVel :: Float, + _lastPos :: Float +} deriving (Eq, Show) + +data Stats = Stats { + _player1Count :: Integer, + _player2Count :: Integer +} deriving (Eq, Show) + +data GameData = GameData { + _paddle1 :: Paddle, + _paddle2 :: Paddle, + _ball :: Ball, + _stats :: Stats, + _ticker :: Timer, + _state :: GameLoopState, + _randGen :: StdGen +} + +data GameConfig = GameConfig { + _font :: Font, + _screen :: Surface, + _ballSprite :: Surface, + _paddleSprite :: Surface, + _pausedSprite :: Surface, + _wallBounce :: Chunk, + _paddleBounce :: Chunk, + _winSound :: Chunk +} + +$(mkLabels [''Ball, ''Paddle, ''Stats, ''GameData, ''GameConfig]) + +getTicksM :: (MonadIO m, MonadState GameData m) => m Word32 +getTicksM = getM ticker >>= getTicks + +stopTicks :: (MonadIO m, MonadState GameData m) => m () +stopTicks = modM_ ticker stop + +startTicks :: (MonadIO m, MonadState GameData m) => m () +startTicks = modM_ ticker start + +resetTicks :: (MonadIO m, MonadState GameData m) => m () +resetTicks = start timer >>= setM ticker + +newBall :: RandomGen g => Player -> Vector2f -> g -> (Ball,g) +newBall p pos g = (Ball pos vel, g')--(-141.4,-141.4) + where (deg,g') = randomR (135,225) g + angle = deg * degToRad + vel = (xdir * ballVel * cos angle, ballVel * sin angle) + xdir = case p of + Player1 -> 1 + Player2 -> (-1) + +newBallM :: (MonadState GameData m) => Player -> Vector2f -> m Ball +newBallM p pos = do + rgen <- getM randGen + let (b, rgen') = newBall p pos rgen + randGen =: rgen' + return b + +gameData :: Vector2f -> Vector2f -> Vector2f -> Timer -> GameData +gameData p1 p2 b ticks = GameData (Paddle p1 0 p1LastPos) (Paddle p2 0 p2LastPos) (Ball b (200.0,0)) (Stats 0 0) ticks (Init Player1) $ mkStdGen 0 + where p1LastPos = snd p1 + p2LastPos = snd p2 + +mapPlayer :: Player -> Stats :-> Integer +mapPlayer Player1 = player1Count +mapPlayer Player2 = player2Count diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License + +Copyright (c) 2010 Korcan Hussein + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/Labels.hs b/Labels.hs new file mode 100644 --- /dev/null +++ b/Labels.hs @@ -0,0 +1,40 @@ +{- + The MIT License + + Copyright (c) 2010 Korcan Hussein + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. +-} +{-# LANGUAGE TemplateHaskell, TypeOperators #-} +module Labels where + +import Prelude hiding (id, (.), mod) +import Control.Category +import Control.Monad.Reader +import Control.Monad.State hiding (get) + +import Data.Record.Label + +askM :: MonadReader r m => (r :-> b) -> m b +askM = asks . get +{-# INLINE askM #-} + +modM_ :: MonadState s m => (s :-> b) -> (b -> m b) -> m () +modM_ label act = getM label >>= act >>= setM label +{-# INLINE modM_ #-} diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,1 @@ +YACPong. ====== Author: Korcan Hussein Install ------- cabal configure cabal build cabal install Or: runhaskell Setup.hs configure --user runhaskell Setup.hs build runhaskell Setup.hs install Keys ------- W/S - to move the paddle up/down P - Pauses the game. ESCAPE - exit the game. Known Issues. ----------------- In this version collision with the side of the paddle is detected but there is no proper response so sometimes the ball can not continue moving. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Sound.hs b/Sound.hs new file mode 100644 --- /dev/null +++ b/Sound.hs @@ -0,0 +1,86 @@ +-- The MIT License +-- +-- Copyright (c) 2010 Korcan Hussein. +-- +-- Permission is hereby granted, free of charge, to any person obtaining a copy +-- of this software and associated documentation files (the "Software"), to deal +-- in the Software without restriction, including without limitation the rights +-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +-- copies of the Software, and to permit persons to whom the Software is +-- furnished to do so, subject to the following conditions: +-- +-- The above copyright notice and this permission notice shall be included in +-- all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +-- THE SOFTWARE. + +----------------------------------------------------------------------------- +-- +-- Module : Sound +-- Copyright : Copyright (c) 2010 Korcan Hussein. +-- License : MIT +-- +-- Maintainer : korcan_h@hotmail.com +-- Stability : +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Sound ( + playWallSound, + playPaddleSound, + playWinSound, + isPlayingWin +) where + +import Control.Monad +import Control.Monad.Trans + +import Labels +import GameState +import GameEnv + +import Graphics.UI.SDL.Mixer + +-- default number of channels available in SDL-mixer is 8 +wallSoundID = 0 +paddleSoundID = 1 +winSoundID = 2 + +playWallSound :: GameEnv () +playWallSound = do + wb <- askM wallBounce +-- playing <- liftIO $ isChannelPlaying winSoundID +-- when (not playing) $ do + liftIO $ playChannel wallSoundID wb 0 + return () + +playPaddleSound :: GameEnv () +playPaddleSound = do + pb <- askM paddleBounce +-- playing <- liftIO $ isChannelPlaying paddleSoundID +-- when (not playing) $ do + liftIO $ playChannel paddleSoundID pb 0 + return () + +playWinSound :: GameEnv() +playWinSound = do + ws <- askM winSound + liftIO $ haltChannel winSoundID + liftIO $ playChannel winSoundID ws 0 + return () + +isPlayingWin :: GameEnv Bool +isPlayingWin = do + ws <- askM winSound + currPlaying <- liftIO $ getChunk winSoundID + isplaying <- liftIO $ isChannelPlaying winSoundID + return $ ws == currPlaying && isplaying diff --git a/Surface.hs b/Surface.hs new file mode 100644 --- /dev/null +++ b/Surface.hs @@ -0,0 +1,97 @@ +{- + The MIT License + + Copyright (c) 2010 Korcan Hussein + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. +-} +module Surface where + +import Foreign + +import Control.Monad +import Control.Monad.Trans + +import Graphics.UI.SDL +import Graphics.UI.SDL.Image + +isInside :: Rect -> Int -> Int -> Bool +isInside (Rect sx sy w h) x y = x > sx && x < (sx + w) && y > sy && y < (sy + h) + +loadImage :: String -> Maybe (Word8, Word8, Word8) -> IO Surface +loadImage filename colorKey = load filename >>= displayFormat >>= setColorKey' colorKey + +setColorKey' :: Maybe (Word8,Word8,Word8) -> Surface -> IO Surface +setColorKey' Nothing s = return s +setColorKey' (Just (r, g, b)) surface = mapRGB' surface r g b >>= setColorKey surface [SrcColorKey] >> return surface + +applySurface :: Int -> Int -> Surface -> Surface -> Maybe Rect -> IO () +applySurface x y src dst clip = blitSurface src clip dst offset >> return () + where offset = Just Rect { rectX = x, rectY = y, rectW = 0, rectH = 0 } + +applySurface' :: MonadIO m => Int -> Int -> Surface -> Surface -> Maybe Rect -> m () +applySurface' x y src dst = liftIO . applySurface x y src dst + +mapRGB' :: Surface -> Word8 -> Word8 -> Word8 -> IO Pixel +mapRGB' = mapRGB . surfaceGetPixelFormat + +clear :: Surface -> Word8 -> Word8 -> Word8 -> IO () +clear surf r g b = do + jrect <- Just `liftM` getClipRect surf + clearColor <- mapRGB' surf r g b + fillRect surf jrect clearColor + return () + +getPixel32 :: Surface -> Int -> Int -> IO Pixel +getPixel32 s x y = do + ps <- surfaceGetPixels s + Pixel `liftM` peekElemOff (castPtr ps :: Ptr Word32) offset + where offset = y * (fromIntegral $ surfaceGetPitch s `div` 4) + x + +setPixel32 :: Surface -> Int -> Int -> Pixel -> IO () +setPixel32 s x y (Pixel pixel) = do + ps <- surfaceGetPixels s + pokeElemOff (castPtr ps :: Ptr Word32) offset pixel + where offset = y * (fromIntegral $ surfaceGetPitch s `div` 4) + x + +withLock :: MonadIO m => Surface -> m () -> m () +withLock s act = do + liftIO $ lockSurface s + act + liftIO $ unlockSurface s + +type Point2 = (Int,Int) +data LineDir = Vertical | Horizontal + +drawLine :: Surface -> Point2 -> Int -> Int -> LineDir -> Pixel -> IO () +drawLine dst (x,y) len thickness Horizontal colour = + withLock dst $ + forM_ [(r,c) | c <- [yStart..yEnd], r <- [x..(x + len)]] $ \(r,c) -> + setPixel32 dst r c colour + where halfLen = thickness `div` 2 + yStart = max (y - halfLen) 0 + yEnd = min (yStart + thickness) $ surfaceGetHeight dst + +drawLine dst (x,y) len thickness Vertical colour = + withLock dst $ + forM_ [(r,c) | r <- [xStart..xEnd], c <- [y..(y + len)]] $ \(r,c) -> + setPixel32 dst r c colour + where halfLen = thickness `div` 2 + xStart = max (x - halfLen) 0 + xEnd = min (xStart + thickness) $ surfaceGetWidth dst diff --git a/Timer.hs b/Timer.hs new file mode 100644 --- /dev/null +++ b/Timer.hs @@ -0,0 +1,52 @@ +{- + The MIT License + Copyright (c) 2010 Korcan Hussein + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. +-} +module Timer (Timer(), timer, start, stop, getTicks, isPaused) where + +import Control.Monad.Trans + +import qualified Graphics.UI.SDL.Time as SdlTime +import Data.Word + +data Timer = Timer { startTicks :: Word32, stopTicks :: Word32 } + +timer :: Timer +timer = Timer 0 0 + +start :: MonadIO m => Timer -> m Timer +start Timer { stopTicks=pausedTicks } = getTicksIO >>= \currTick -> return $ Timer (currTick - pausedTicks) 0 + +stop :: MonadIO m => Timer -> m Timer +stop t@Timer { startTicks = st } + | isPaused t = return t + | otherwise = getTicksIO >>= \currTick -> return t { stopTicks=currTick - st } + +getTicks :: MonadIO m => Timer -> m Word32 +getTicks t@Timer { startTicks = st } + | isPaused t = return $ stopTicks t + | otherwise = getTicksIO >>= \currTick -> return $ currTick - st + +isPaused :: Timer -> Bool +isPaused Timer { stopTicks=st } = st > 0 + +getTicksIO :: MonadIO m => m Word32 +getTicksIO = liftIO SdlTime.getTicks diff --git a/Vector2.hs b/Vector2.hs new file mode 100644 --- /dev/null +++ b/Vector2.hs @@ -0,0 +1,50 @@ +{- + The MIT License + + Copyright (c) 2010 Korcan Hussein + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. +-} +module Vector2 where + +type Vector2f = (Float,Float) + +magSq,mag :: Vector2f -> Float +normalize :: Vector2f -> Vector2f +mul :: Float -> Vector2f -> Vector2f +add :: Vector2f -> Vector2f -> Vector2f +sub :: Vector2f -> Vector2f -> Vector2f +dot :: Vector2f -> Vector2f -> Float +reflect :: Vector2f -> Vector2f -> Vector2f + +s `mul` (x, y) = (s * x, s * y) + +(lx, ly)`sub` (rx, ry) = (lx - rx, ly - ry) + +(lx, ly)`add` (rx, ry) = (lx + rx, ly + ry) + +(lx, ly) `dot` (rx, ry) = (lx * rx) + (ly * ry) + +reflect v n = v `sub` (2 ` mul` ((n `dot` v) `mul` n)) + +magSq v = v `dot` v +mag v = sqrt $ magSq v + +normalize v = len `mul` v + where len = 1.0 / mag v diff --git a/YACPong.cabal b/YACPong.cabal new file mode 100644 --- /dev/null +++ b/YACPong.cabal @@ -0,0 +1,52 @@ +name: YACPong +version: 0.1 +cabal-version: >=1.4 +build-type: Simple +license: MIT +license-file: LICENSE +copyright: Copyright (c) 2010 Korcan Hussein +maintainer: korcan_h@hotmail.com +build-depends: SDL -any, SDL-image -any, SDL-mixer -any, + SDL-ttf -any, base >=4 && <5, data-accessor-transformers -any, + fclabels -any, monads-fd -any, random -any, transformers -any +stability: +homepage: http://github.com/snkkid/YACPong +package-url: +bug-reports: +synopsis: Yet Another Pong Clone using SDL. +description: Yet Another Pong Clone using SDL. +category: Game +author: Korcan Hussein +tested-with: GHC -any +data-files: Crysta.ttf paddle.wav wall.wav win.wav +data-dir: data +extra-source-files: Collision.hs Consts.hs Draw.hs GameEnv.hs + GameState.hs Labels.hs README Sound.hs Surface.hs Timer.hs + Vector2.hs YACPong.hs +extra-tmp-files: + +executable: YACPong +main-is: YACPong.hs +buildable: True +build-tools: +cpp-options: +cc-options: +ld-options: +pkgconfig-depends: +frameworks: +c-sources: +extensions: +extra-libraries: +extra-lib-dirs: +includes: +install-includes: +include-dirs: +hs-source-dirs: . +other-modules: Collision Consts Draw GameEnv GameState Labels Sound + Surface Timer Vector2 +ghc-prof-options: +ghc-shared-options: +ghc-options: +hugs-options: +nhc98-options: +jhc-options: diff --git a/YACPong.hs b/YACPong.hs new file mode 100644 --- /dev/null +++ b/YACPong.hs @@ -0,0 +1,375 @@ +{- + The MIT License + + Copyright (c) 2010 Korcan Hussein. + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. +-} +{-# LANGUAGE FlexibleContexts, ForeignFunctionInterface #-} +module Main where + +import Prelude hiding (id, (.), mod, init) + +import Foreign +import Foreign.C.Types + +import Control.Category + +import Control.Monad +import Control.Monad.State hiding (get) +import qualified Control.Monad.State as MState (get) +import Control.Monad.Reader +import Control.Monad.Trans + +import Control.Exception + +import Data.Maybe +import Data.Either +import Data.Record.Label +import Data.List hiding (init, intersect) + +import Graphics.UI.SDL hiding (init, quit, flip, update, getTicks) +import qualified Graphics.UI.SDL as SDL (flip) +import qualified Graphics.UI.SDL.Utilities as Util + +import Graphics.UI.SDL.TTF hiding (init, quit) +import qualified Graphics.UI.SDL.TTF as TTFG (init, quit) + +import Graphics.UI.SDL.Mixer + +import Labels +import Timer +import Vector2 +import Collision +import Surface +import GameState +import GameEnv +import Consts +import Sound +import Draw +import Paths_YACPong + +-- SDL_GetKeyState is not defined in Graphic.UI.SDL +foreign import ccall unsafe "SDL_GetKeyState" sdlGetKeyState :: Ptr CInt -> IO (Ptr Word8) + +type KeyProc = SDLKey -> Bool +-- this function comes from mokehehe's super nario bros: http://github.com/mokehehe/monao in the file "AppUtil.hs" +getKeyState :: MonadIO m => m KeyProc +getKeyState = liftIO $ alloca $ \numkeysPtr -> do + keysPtr <- sdlGetKeyState numkeysPtr + return $ \k -> (/= 0) $ unsafePerformIO $ (peekByteOff keysPtr $ fromIntegral $ Util.fromEnum k :: IO Word8) + +init :: IO (GameConfig, GameData) +init = do + screen <- setVideoMode (truncate screenWidth) (truncate screenHeight) screenBpp [HWSurface, DoubleBuf] + setCaption "YACPong" [] + enableUnicode True + + fontFileName <- getDataFileName "Crysta.ttf" + wallFileName <- getDataFileName "wall.wav" + paddleFileName <- getDataFileName "paddle.wav" + winFileName <- getDataFileName "win.wav" + + font <- openFont fontFileName 36 + wallBounce <- loadWAV wallFileName + paddleBounce <- loadWAV paddleFileName + winSound <- loadWAV winFileName + + paddleSprite <- createRGBSurfaceEndian [HWSurface] paddleW' paddleH' screenBpp + ballSprite <- createRGBSurfaceEndian [HWSurface] ballW' ballH' screenBpp + + paddleColor <- mapRGB' paddleSprite 0xFF 0xFF 0x00 + ballColor <- mapRGB' ballSprite 0x3F 0xFF 0xF5 + + fillRect paddleSprite (Just $ Rect 0 0 paddleW' paddleH') paddleColor + fillRect ballSprite (Just $ Rect 0 0 ballW' ballH') ballColor + + paused <- renderTextSolid font "PAUSED" textColor + + currTicks <- start timer + + return (GameConfig font screen ballSprite paddleSprite paused wallBounce paddleBounce winSound, gameData pPos1 pPos2 bPos currTicks) + where paddleW' = truncate paddleW + paddleH' = truncate paddleH + ballW' = truncate ballW + ballH' = truncate ballH + --from (x,y) = (fromIntegral x, fromIntegral y) + pPos1 = (10, halfHeight - paddleH / 2) + pPos2 = (screenWidth - 10 - paddleW, halfHeight - paddleH / 2) + bPos = (halfWidth, halfHeight) + +--whichSide :: Bounds -> Bounds -> Vector2f +--Bounds (lx,ly,lw,lh) `whichSide` Bounds (rx,ry,rw,rh) = flip execState (0,0) $ do +-- when ((lx + lw) <= rx) $ do +-- modify $ \(_,ny) -> (-1,ny) +-- +-- when (lx >= (rx + rw)) $ do +-- modify $ \(_,ny) -> (1,ny) +-- +-- when ((ly + lh) <= ry) $ do +-- modify $ \(nx,_) -> (nx,-1) +-- +-- when (ly >= (ry + rh)) $ do +-- modify $ \(nx,_) -> (nx,1) + +collide :: Float -> Paddle -> Ball -> Maybe (Float,Float) +collide dt Paddle { _pPos=(px,py), _yVel=yVel } b@Ball { _pos=(x,y), _vel=v } = + intersectMoving (Bounds (px,py,pW,pH)) (Bounds (x,y,bW,bH)) (0, dt * yVel) (dt `mul` v) + where bW = ballW + bH = ballH + pW = paddleW + pH = paddleH + +data CollisionType = + CtWall (Either Paddle Ball) + | CtPaddle Paddle + | CtLeftNet + | CtRightNet + | CtNone + +type CollisionEvent = (CollisionType, Float) + +paddleInside :: Float -> Paddle -> Bool +paddleInside dt paddle = not $ y' < 0 || y' + paddleH > screenHeight + where (_,y) = get pPos paddle + vel = get yVel paddle + y' = vel * dt + y + +findBallCollision :: Float -> [Paddle] -> Ball -> CollisionEvent +findBallCollision dt paddles b@Ball { _pos=bp@(x,y), _vel=v@(dx,dy) } + | x' > 0 && x' < screenWidth && y' > 0 && y' < screenHeight = --b { _pos=(x',y') } + let intersecting (_, Nothing) = False + intersecting (_, Just (0,_)) = False + intersecting _ = True + collided = find intersecting $ map (\p -> (p, collide dt p b)) paddles + in case collided of + Just (p, Just (t1,_)) -> (CtPaddle p, t1) + _ -> (CtNone, 0) + | x' < 0 = (CtLeftNet, dt) + | x' > screenWidth = (CtRightNet, dt) + | y' < 0 = (CtWall $ Right b, dt) + | y' > screenHeight = (CtWall $ Right b, dt) + | otherwise = (CtNone, 0) + where x' = dx * dt + x + y' = dy * dt + y + +findCollisions :: Float -> GameEnv [CollisionEvent] +findCollisions dt = do + p1 <- getM paddle1 + p2 <- getM paddle2 + let paddles = filter (not . paddleInside dt) [p1,p2] + let wallPaddles = map (\p -> (CtWall $ Left p,dt)) paddles + + result <- findBallCollision dt [p1,p2] `liftM` getM ball + case result of + (CtNone,_) -> return wallPaddles + _ -> return $ result : wallPaddles + +think :: Ball -> Vector2f -> Paddle -> Paddle +think (Ball (bx,by) bv) pv p@Paddle { _pPos=(x,y), _yVel=pVel, _lastPos=oldY } + | ang < 0 = + let newVel = if by < y then -paddleVel + else if by > y + paddleH + then paddleVel + else 0 + p' = saveLastPos newVel p -- capture the first y-pos of the paddle. + in p' { _yVel=newVel } + | otherwise = set yVel 0 p + where ang = bv `dot` pv + +react :: CollisionEvent -> GameEnv () +react (CtWall (Left p), _) = do + p1 <- getM paddle1 + + let playerL = if p1 == p then paddle1 else paddle2 + modM playerL $ \p@Paddle { _pPos=(x,y) } -> + p { _pPos=(min w $ max x 0, min h $ max y 0) } + where w = screenWidth + h = screenHeight + +react (CtWall (Right b@Ball { _pos=(x,y), _vel=(dx,dy) }), dt) = do + setM ball b { _pos=pos', _vel=reflect (dx,dy) wallNormal } + playWallSound + where x' = x + dt * dx + y' = y + dt * dy + (pos', wallNormal) = execState collideWall ((x',y'),(0,0)) + collideWall :: State (Vector2f,Vector2f) () + collideWall = do + --modify $ \k@((u,v),(_,ny)) -> if u < 0 then ((0,v),(1,ny)) else k + --modify $ \k@((u,v),(_,ny)) -> if u > fromIntegral screenWidth then ((fromIntegral $ screenWidth - 1, v),(-1,ny)) else k + modify $ \k@((u,v),(nx,_)) -> if v < 0 then ((u, 0),(nx,1)) else k + modify $ \k@((u,v),(nx,_)) -> if v > screenHeight then ((u, screenHeight - 1),(nx,-1)) else k + +react (CtPaddle p, t) = do + modM ball $ \b@Ball { _pos=bp, _vel=v } -> + let v' = t `mul` normalize v + p' = bp `add` v' + --n = whichSide (i,j,bW,bH) (px,py + dt * yVel,pW,pH) + --in b { _pos=p', _vel=(0, paddleVel) `add` reflect v (1,0) } + in b { _pos=p', _vel=paddleInflunceVec `add` reflect v (1,0) } + playPaddleSound + where currY = snd $ get pPos p + paddleVel = get yVel p + lastY = get lastPos p + paddleInflunceVec = if lastY == 0 then (0,0) else (0, currY - lastY) + +react (CtLeftNet,_) = do + state =: Win Player1 + modM (player2Count . stats) (+1) + playWinSound + +react (CtRightNet, _) = do + state =: Win Player2 + modM (player1Count . stats) (+1) + playWinSound + +react (CtNone, _) = return () + +updatePaddle :: Float -> Paddle -> Paddle +updatePaddle dt paddle = set pPos (x,y') paddle + where (x,y) = get pPos paddle + vel = get yVel paddle + y' = vel * dt + y + +updateBall :: Float -> Ball -> Ball +updateBall dt b@Ball { _pos=bp@(x,y), _vel=v@(dx,dy) } = b { _pos=(x',y') } + where x' = dx * dt + x + y' = dy * dt + y + +saveLastPos :: Float -> Paddle -> Paddle +saveLastPos nextVel p + | currVel == 0 && nextVel /= 0 = p { _lastPos = snd $ get pPos p } + | currVel /= 0 && nextVel == 0 = p { _lastPos = 0 } + | otherwise = p + where currVel = get yVel p + +update :: Float -> GameEnv () +update dt = do + + keyState <- getKeyState + + let pVel = if keyState SDLK_w + then -paddleVel + else if (keyState SDLK_s) + then paddleVel + else 0.0 + + -- capture the first y-pos of the player's paddle. + modM paddle1 $ saveLastPos pVel + + setM (yVel . paddle1) pVel + + b <- getM ball + modM paddle2 $ think b (-1,0) + + collisions <- findCollisions dt + + forM_ collisions react + + when (all ballNotHit collisions) $ + modM ball $ updateBall dt + + p1 <- getM paddle1 + when (all (paddleNotHit p1) collisions) $ + modM paddle1 $ updatePaddle dt + + p2 <- getM paddle2 + when (all (paddleNotHit p2) collisions) $ + modM paddle2 $ updatePaddle dt + + where ballNotHit :: CollisionEvent -> Bool + ballNotHit (CtWall (Left _), _) = True + ballNotHit (CtNone, _) = True + ballNotHit _ = False + + paddleNotHit :: Paddle -> CollisionEvent -> Bool + paddleNotHit p (CtWall (Left c), _) = p /= c + paddleNotHit _ (CtWall (Right _), _) = True + paddleNotHit _ (CtNone, _) = True + paddleNotHit _ _ = False + +nextState_ :: GameLoopState -> GameEnv () +nextState_ w@(Win player) = do + renderWin + isWinPlay <- isPlayingWin + stopTicks + let result = if isWinPlay then w else Init player + state =: result + +nextState_ (Init player) = do + setM ball =<< newBallM player (halfWidth, halfHeight) + state =: Play + +nextState_ Play = do + dt <- getTicksM + update $ secs * fromIntegral dt + resetTicks + render + +nextState_ Paused = do + renderPaused + stopTicks + +nextState :: GameEnv () +nextState = getM state >>= nextState_ + +loop :: GameEnv () +loop = do + quit <- whileEvents $ \event -> do + gs <- getM state + case (event, gs) of + (KeyDown (Keysym SDLK_p _ _), Play) -> setM state Paused + (KeyDown (Keysym SDLK_p _ _), Paused) -> setM state Play + _ -> return () + + nextState + + -- TODO: use high res performance timer. + liftIO $ delay 1 + + unless quit loop + +whileEvents :: MonadIO m => (Event -> m ()) -> m Bool +whileEvents act = do + event <- liftIO pollEvent + case event of + Quit -> return True + KeyDown (Keysym SDLK_ESCAPE _ _) -> return True + NoEvent -> return False + _ -> do + act event + whileEvents act + +main :: IO () +main = withSDL $ do + (config, state) <- init + runGame config state loop + return () + +withSDL :: IO () -> IO () +withSDL act = withInit [InitEverything] $ do -- withInit calls quit for us. + bracket_ sdlInit sdlQuit act + where sdlInit :: IO () + sdlInit = do + success <- TTFG.init + when (not success) $ + throwIO $ userError "Failed to init ttf\n" + openAudio 44100 AudioS16Sys 2 4096 + sdlQuit :: IO () + sdlQuit = closeAudio >> TTFG.quit diff --git a/data/Crysta.ttf b/data/Crysta.ttf new file mode 100644 Binary files /dev/null and b/data/Crysta.ttf differ diff --git a/data/paddle.wav b/data/paddle.wav new file mode 100644 Binary files /dev/null and b/data/paddle.wav differ diff --git a/data/wall.wav b/data/wall.wav new file mode 100644 Binary files /dev/null and b/data/wall.wav differ diff --git a/data/win.wav b/data/win.wav new file mode 100644 Binary files /dev/null and b/data/win.wav differ