diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,11 +1,56 @@ -0.4.4 +0.4.5 2014/10/8 -* add missing files to cabal file (Samuel Gélineau) +* add executables to run examples (fungen-hello, fungen-pong, fungen-worms) -* support & require latest OpenGL 2.9 +0.4.4 2014/10/7 +* add missing files to cabal file (Samuel Gélineau) +* support & require latest OpenGL 2.9 * make IOGame also a Functor and Applicative, for ghc 7.10 -0.4.3 +0.4.3 2014/4/5 * set upper bound on OpenGL to avoid build failure with OpenGL 2.9 + +0.4.2 2013/08/07 + +* add q as quit key to examples +* fix buggy input when holding down keys on windows + +0.4.1 2013/08/06 + +* reorganised and exposed more haddocks + +0.4 2013/08/05 + +* a new hakyll-based website, incorporating the old site +* tested with GHC 7.6 +* input handlers now receive mouse position and modifier state + (inspired by Pradeep Kumar). See fungentest.hs for examples. +* more haddocks + +0.3 2011/02/13, Simon Michael + +* updated for GHC 6.12 & base 4 +* module names simplified +* beginning of haddockification +* docs moved into repo +* published to darcsden, hackage, wiki, haskell-cafe, #haskell-game, reddit + +0.1-hackage 2008/09/17, Miloslav Raus + +* first hackage release +* updated for GHC 6.10 +* cabalised +* Tested under Win32 & Linux/Intel. Known glitches: Flickering under linux + (at least on my shitty laptop). Weird pong paddle behavior under Win32. + +0.1-ghc6.8 2008/02/26, Simon Michael + +* updated for GHC 6.8 +* slight tweaks to examples +* public darcs repo + +0.1 2002, Andre Furtado + +* first public release diff --git a/FunGEn.cabal b/FunGEn.cabal --- a/FunGEn.cabal +++ b/FunGEn.cabal @@ -1,5 +1,5 @@ name: FunGEn -version: 0.4.4 +version: 0.4.5 copyright: (C) 2002 Andre Furtado license: BSD3 license-file: LICENSE @@ -10,33 +10,15 @@ synopsis: FUNctional Game ENgine description: A lightweight, cross-platform, OpenGL/GLUT-based game engine stability: alpha -cabal-version: >= 1.6 +cabal-version: >= 1.8 build-type: Simple tested-with: GHC==7.8.2 extra-source-files: - README.md, - CHANGES, - examples/pong/hit.wav, - examples/pong/pong.hs, - examples/pong/tex.bmp, - examples/worms/border1.bmp, - examples/worms/border2.bmp, - examples/worms/border3.bmp, - examples/worms/congratulations.bmp, - examples/worms/food.bmp, - examples/worms/free1.bmp, - examples/worms/free2.bmp, - examples/worms/free3.bmp, - examples/worms/gameover.bmp, - examples/worms/heade.bmp, - examples/worms/heads.bmp, - examples/worms/headn.bmp, - examples/worms/headw.bmp, - examples/worms/level1.bmp, - examples/worms/level2.bmp, - examples/worms/level3.bmp, - examples/worms/segment.bmp, - examples/worms/worms.hs + README.md, + CHANGES +data-files: + examples/pong/*.bmp, + examples/worms/*.bmp library ghc-options: -W @@ -59,4 +41,34 @@ base == 4.* ,OpenGL == 2.9.* ,GLUT == 2.5.* + ,random + +executable fungen-hello + ghc-options: -W + hs-source-dirs: examples + main-is: hello.hs + build-depends: FunGEn + ,base + ,OpenGL + ,GLUT + ,random + +executable fungen-pong + ghc-options: -W + hs-source-dirs: examples + main-is: pong/pong.hs + build-depends: FunGEn == 0.4.* + ,base + ,OpenGL + ,GLUT + ,random + +executable fungen-worms + ghc-options: -W + hs-source-dirs: examples + main-is: worms/worms.hs + build-depends: FunGEn == 0.4.* + ,base + ,OpenGL + ,GLUT ,random diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -19,11 +19,11 @@
- +
- +
- +
# Functional Game Engine @@ -52,6 +52,8 @@ **Home:** \ **Hackage:** \ + +**Changelog:** \ **Code:** \ **Discussion & help:** [#haskell-game](http://www.haskell.org/haskellwiki/IRC_channel) IRC channel, @@ -59,7 +61,7 @@ \ **Docs:** [API docs](http://hackage.haskell.org/packages/archive/FunGEn/0.4.2/doc/html/Graphics-UI-Fungen.html), - Andre's [pong tutorial](site-files/example.html), + Andre's [pong tutorial](site/example.html), Stack Overflow [FunGEn questions](http://stackoverflow.com/search?tab=newest&q=fungen), \ @@ -132,54 +134,6 @@ --- -## Release notes - -### 0.4.2 (2013/08/07) - -* add q as quit key to examples -* fix buggy input when holding down keys on windows - -### 0.4.1 (2013/08/06) - -* reorganised and exposed more haddocks - -### 0.4 (2013/08/05) - -* a new hakyll-based website, incorporating the old site -* tested with GHC 7.6 -* input handlers now receive mouse position and modifier state - (inspired by Pradeep Kumar). See fungentest.hs for examples. -* more haddocks - -### 0.3 (2011/02/13) -GHC 6.12-compatible 0.3 [released](http://thread.gmane.org/gmane.comp.lang.haskell.cafe/86330) on darcsden & hackage by Simon Michael: - -- updated for GHC 6.12 & base 4 -- module names simplified -- beginning of haddockification -- docs moved into repo -- published to darcsden, hackage, wiki, haskell-cafe, #haskell-game, reddit - -### 0.1-hackage (2008/09/17) -GHC 6.10-compatible 0.1 released on hackage by Miloslav Raus: - -- updated for GHC 6.10 -- cabalised -- Tested under Win32 & Linux/Intel. Known glitches: Flickering under linux - (at least on my shitty laptop). Weird pong paddle behavior under Win32. - -### GHC 6.8 update (2008/02/26) -GHC 6.8-compatible update by Simon Michael: - -- updated for GHC 6.8 -- slight tweaks to examples -- public darcs repo - -### 0.1 (2002) -First public release by Andre Furtado: - ---- - ## To do Andre's 2002 site included this message: @@ -210,7 +164,7 @@ > Would you like to suggest a feature? Feel free to do it. Would you like to > implement a feature? Please do it! Keep in touch. -and this [old windows code with sound support](/site-files/FunGEn0.1-Win32.zip). +and this [old windows code with sound support](/site/FunGEn0.1-Win32.zip). --- diff --git a/examples/hello.hs b/examples/hello.hs new file mode 100644 --- /dev/null +++ b/examples/hello.hs @@ -0,0 +1,11 @@ +module Main where + +import Graphics.UI.Fungen + +main :: IO () +main = + let winConfig = ((50,50),(500,300),"Hello, Fungen World! Press Q to quit") + gameMap = colorMap 0.0 0.0 0.0 250 250 + bindings = [(Char 'q', Press, \_ _ -> funExit)] + in funInit winConfig gameMap [] () () bindings (return()) Idle [] + diff --git a/examples/pong/hit.wav b/examples/pong/hit.wav deleted file mode 100644 Binary files a/examples/pong/hit.wav and /dev/null differ diff --git a/examples/pong/pong.hs b/examples/pong/pong.hs --- a/examples/pong/pong.hs +++ b/examples/pong/pong.hs @@ -14,6 +14,7 @@ import Graphics.UI.Fungen import Graphics.Rendering.OpenGL (GLdouble) +import Paths_FunGEn (getDataFileName) data GameAttribute = Score Int @@ -24,65 +25,70 @@ main :: IO () main = do - let winConfig = ((100,20),(width,height),"A brief example!") - bmpList = [("tex.bmp",Nothing)] - gameMap = textureMap 0 30 30 w h - bar = objectGroup "barGroup" [createBar] - ball = objectGroup "ballGroup" [createBall] - initScore = Score 0 - input = [ - (SpecialKey KeyRight, StillDown, moveBarToRight) - ,(SpecialKey KeyLeft, StillDown, moveBarToLeft) - ,(Char 'q', Press, \_ _ -> funExit) - ] - funInit winConfig gameMap [bar,ball] () initScore input gameCycle (Timer 30) bmpList + texbmp <- getDataFileName "examples/pong/tex.bmp" + let winConfig = ((100,80),(width,height),"A brief example!") + bmpList = [(texbmp, Nothing)] + gameMap = textureMap 0 30 30 w h + bar = objectGroup "barGroup" [createBar] + ball = objectGroup "ballGroup" [createBall] + initScore = Score 0 + input = [ + (SpecialKey KeyRight, StillDown, moveBarToRight) + ,(SpecialKey KeyLeft, StillDown, moveBarToLeft) + ,(Char 'q', Press, \_ _ -> funExit) + ] + funInit winConfig gameMap [bar,ball] () initScore input gameCycle (Timer 30) bmpList createBall :: GameObject () -createBall = let ballPic = Basic (Circle 6.0 0.0 1.0 0.0 Filled) - in object "ball" ballPic False (w/2,h/2) (-8,8) () - +createBall = + let ballPic = Basic (Circle 6.0 0.0 1.0 0.0 Filled) + in object "ball" ballPic False (w/2,h/2) (-8,8) () createBar :: GameObject () -createBar = let barBound = [(-25,-6),(25,-6),(25,6),(-25,6)] - barPic = Basic (Polyg barBound 1.0 1.0 1.0 Filled) - in object "bar" barPic False (w/2,30) (0,0) () +createBar = + let barBound = [(-25,-6),(25,-6),(25,6),(-25,6)] + barPic = Basic (Polyg barBound 1.0 1.0 1.0 Filled) + in object "bar" barPic False (w/2,30) (0,0) () moveBarToRight :: Modifiers -> Position -> IOGame GameAttribute () () () () -moveBarToRight mods pos = do - obj <- findObject "bar" "barGroup" - (pX,pY) <- getObjectPosition obj - (sX,_) <- getObjectSize obj - if (pX + (sX/2) + 5 <= w) - then (setObjectPosition ((pX + 5),pY) obj) - else (setObjectPosition ((w - (sX/2)),pY) obj) +moveBarToRight _ _ = do + obj <- findObject "bar" "barGroup" + (pX,pY) <- getObjectPosition obj + (sX,_) <- getObjectSize obj + if (pX + (sX/2) + 5 <= w) + then (setObjectPosition ((pX + 5),pY) obj) + else (setObjectPosition ((w - (sX/2)),pY) obj) moveBarToLeft :: Modifiers -> Position -> IOGame GameAttribute () () () () -moveBarToLeft mods pos = do - obj <- findObject "bar" "barGroup" - (pX,pY) <- getObjectPosition obj - (sX,_) <- getObjectSize obj - if (pX - (sX/2) - 5 >= 0) - then (setObjectPosition ((pX - 5),pY) obj) - else (setObjectPosition (sX/2,pY) obj) +moveBarToLeft _ _ = do + obj <- findObject "bar" "barGroup" + (pX,pY) <- getObjectPosition obj + (sX,_) <- getObjectSize obj + if (pX - (sX/2) - 5 >= 0) + then (setObjectPosition ((pX - 5),pY) obj) + else (setObjectPosition (sX/2,pY) obj) gameCycle :: IOGame GameAttribute () () () () gameCycle = do - (Score n) <- getGameAttribute - printOnScreen (show n) TimesRoman24 (0,0) 1.0 1.0 1.0 + (Score n) <- getGameAttribute + printOnScreen (show n) TimesRoman24 (0,0) 1.0 1.0 1.0 - ball <- findObject "ball" "ballGroup" - col1 <- objectLeftMapCollision ball - col2 <- objectRightMapCollision ball - when (col1 || col2) (reverseXSpeed ball) - col3 <- objectTopMapCollision ball - when col3 (reverseYSpeed ball) - col4 <- objectBottomMapCollision ball - when col4 (do reverseYSpeed ball) -- (funExit) + ball <- findObject "ball" "ballGroup" + col1 <- objectLeftMapCollision ball + col2 <- objectRightMapCollision ball + when (col1 || col2) (reverseXSpeed ball) + col3 <- objectTopMapCollision ball + when col3 (reverseYSpeed ball) + col4 <- objectBottomMapCollision ball + when col4 $ do + -- funExit + setGameAttribute (Score 0) + reverseYSpeed ball - bar <- findObject "bar" "barGroup" - col5 <- objectsCollision ball bar - let (_,vy) = getGameObjectSpeed ball - when (and [col5, vy < 0]) (do reverseYSpeed ball - setGameAttribute (Score (n + 10))) - showFPS TimesRoman24 (w-40,0) 1.0 0.0 0.0 + bar <- findObject "bar" "barGroup" + col5 <- objectsCollision ball bar + let (_,vy) = getGameObjectSpeed ball + when (and [col5, vy < 0]) (do reverseYSpeed ball + setGameAttribute (Score (n + 10))) + showFPS TimesRoman24 (w-40,0) 1.0 0.0 0.0 diff --git a/examples/worms/worms.hs b/examples/worms/worms.hs --- a/examples/worms/worms.hs +++ b/examples/worms/worms.hs @@ -15,6 +15,7 @@ import Text.Printf import Graphics.UI.Fungen import Graphics.Rendering.OpenGL (GLdouble) +import Paths_FunGEn (getDataFileName) data GameAttribute = GA Int Int Int (GLdouble,GLdouble) Int data ObjectAttribute = NoObjectAttribute | Tail Int @@ -44,23 +45,23 @@ magenta = Just [(255,0,255)] bmpList :: FilePictureList -bmpList = [("level1.bmp", Nothing), - ("level2.bmp", Nothing), +bmpList = [("level1.bmp", Nothing), + ("level2.bmp", Nothing), ("level3.bmp", Nothing), ("gameover.bmp", magenta), ("congratulations.bmp", magenta), - ("headn.bmp", magenta), - ("heads.bmp", magenta), - ("heade.bmp", magenta), - ("headw.bmp", magenta), - ("food.bmp", magenta), - ("segment.bmp", magenta), - ("border1.bmp", magenta), - ("border2.bmp", magenta), - ("border3.bmp", magenta), - ("free1.bmp", magenta), - ("free2.bmp", magenta), - ("free3.bmp", magenta)] + ("headn.bmp", magenta), + ("heads.bmp", magenta), + ("heade.bmp", magenta), + ("headw.bmp", magenta), + ("food.bmp", magenta), + ("segment.bmp", magenta), + ("border1.bmp", magenta), + ("border2.bmp", magenta), + ("border3.bmp", magenta), + ("free1.bmp", magenta), + ("free2.bmp", magenta), + ("free3.bmp", magenta)] -- position of the paths in the list: border1, border2, border3, free1, free2, free3 :: Int @@ -73,40 +74,42 @@ main :: IO () main = do - let winConfig = ((100,50),(780,600),"WORMS - by Andre Furtado") + let winConfig = ((200,100),(780,600),"WORMS - by Andre Furtado") - gameMap = multiMap [(tileMap map1 tileSize tileSize), - (tileMap map2 tileSize tileSize), - (tileMap map3 tileSize tileSize)] 0 + gameMap = multiMap [(tileMap map1 tileSize tileSize), + (tileMap map2 tileSize tileSize), + (tileMap map3 tileSize tileSize)] 0 - gameAttribute = GA defaultTimer maxFood initTailSize initPos 0 + gameAttribute = GA defaultTimer maxFood initTailSize initPos 0 - groups = [(objectGroup "messages" createMsgs ), - (objectGroup "head" [createHead]), - (objectGroup "food" [createFood]), - (objectGroup "tail" createTail )] + groups = [(objectGroup "messages" createMsgs ), + (objectGroup "head" [createHead]), + (objectGroup "food" [createFood]), + (objectGroup "tail" createTail )] - input = [ - (SpecialKey KeyLeft, Press, turnLeft ), - (SpecialKey KeyRight, Press, turnRight), - (SpecialKey KeyUp, Press, turnUp ), - (SpecialKey KeyDown, Press, turnDown ) - ,(Char 'q', Press, \_ _ -> funExit) - ] - - funInit winConfig gameMap groups (LevelStart 1) gameAttribute input gameCycle (Timer 150) bmpList + input = [ + (SpecialKey KeyLeft, Press, turnLeft ), + (SpecialKey KeyRight, Press, turnRight), + (SpecialKey KeyUp, Press, turnUp ), + (SpecialKey KeyDown, Press, turnDown ) + ,(Char 'q', Press, \_ _ -> funExit) + ] + + bmpList' <- mapM (\(a,b) -> do { a' <- getDataFileName ("examples/worms/"++a); return (a', b)}) bmpList + funInit winConfig gameMap groups (LevelStart 1) gameAttribute input gameCycle (Timer 150) bmpList' createMsgs :: [WormsObject] -createMsgs = let picLevel1 = Tex (150,50) 0 - picLevel2 = Tex (150,50) 1 - picLevel3 = Tex (150,50) 2 - picGameOver = Tex (300,100) 3 - picCongratulations = Tex (300,100) 4 - in [(object "level1" picLevel1 True (395,300) (0,0) NoObjectAttribute), - (object "level2" picLevel2 True (395,300) (0,0) NoObjectAttribute), - (object "level3" picLevel3 True (395,300) (0,0) NoObjectAttribute), - (object "gameover" picGameOver True (395,300) (0,0) NoObjectAttribute), - (object "congratulations" picCongratulations True (395,300) (0,0) NoObjectAttribute)] +createMsgs = + let picLevel1 = Tex (150,50) 0 + picLevel2 = Tex (150,50) 1 + picLevel3 = Tex (150,50) 2 + picGameOver = Tex (300,100) 3 + picCongratulations = Tex (300,100) 4 + in [(object "level1" picLevel1 True (395,300) (0,0) NoObjectAttribute), + (object "level2" picLevel2 True (395,300) (0,0) NoObjectAttribute), + (object "level3" picLevel3 True (395,300) (0,0) NoObjectAttribute), + (object "gameover" picGameOver True (395,300) (0,0) NoObjectAttribute), + (object "congratulations" picCongratulations True (395,300) (0,0) NoObjectAttribute)] createHead :: WormsObject createHead = let pic = Tex (tileSize,tileSize) 5 @@ -118,112 +121,112 @@ createTail :: [WormsObject] createTail = let picTail = Tex (tileSize,tileSize) 10 - in (object "tail0" picTail False tail0Pos (0,0) (Tail 0)): - (object "tail1" picTail False tail1Pos (0,0) (Tail 1)): - (createAsleepTails initTailSize (initTailSize + maxFood - 1) picTail) + in (object "tail0" picTail False tail0Pos (0,0) (Tail 0)): + (object "tail1" picTail False tail1Pos (0,0) (Tail 1)): + (createAsleepTails initTailSize (initTailSize + maxFood - 1) picTail) createAsleepTails :: Int -> Int -> ObjectPicture -> [WormsObject] createAsleepTails tMin tMax pic - | (tMin > tMax) = [] - | otherwise = (object ("tail" ++ (show tMin)) pic True (0,0) (0,0) (Tail 0)):(createAsleepTails (tMin + 1) tMax pic) + | (tMin > tMax) = [] + | otherwise = (object ("tail" ++ (show tMin)) pic True (0,0) (0,0) (Tail 0)):(createAsleepTails (tMin + 1) tMax pic) turnLeft :: Modifiers -> Position -> WormsAction () turnLeft _ _ = do - snakeHead <- findObject "head" "head" - setObjectCurrentPicture 8 snakeHead - setObjectSpeed (-speedMod,0) snakeHead + snakeHead <- findObject "head" "head" + setObjectCurrentPicture 8 snakeHead + setObjectSpeed (-speedMod,0) snakeHead turnRight :: Modifiers -> Position -> WormsAction () turnRight _ _ = do - snakeHead <- findObject "head" "head" - setObjectCurrentPicture 7 snakeHead - setObjectSpeed (speedMod,0) snakeHead + snakeHead <- findObject "head" "head" + setObjectCurrentPicture 7 snakeHead + setObjectSpeed (speedMod,0) snakeHead turnUp :: Modifiers -> Position -> WormsAction () turnUp _ _ = do - snakeHead <- findObject "head" "head" - setObjectCurrentPicture 5 snakeHead - setObjectSpeed (0,speedMod) snakeHead + snakeHead <- findObject "head" "head" + setObjectCurrentPicture 5 snakeHead + setObjectSpeed (0,speedMod) snakeHead turnDown :: Modifiers -> Position -> WormsAction () turnDown _ _ = do - snakeHead <- findObject "head" "head" - setObjectCurrentPicture 6 snakeHead - setObjectSpeed (0,-speedMod) snakeHead + snakeHead <- findObject "head" "head" + setObjectCurrentPicture 6 snakeHead + setObjectSpeed (0,-speedMod) snakeHead gameCycle :: WormsAction () gameCycle = do - (GA timer remainingFood tailSize previousHeadPos score) <- getGameAttribute - gState <- getGameState - case gState of - LevelStart n -> case n of - 4 -> do - congratulations <- findObject "congratulations" "messages" - drawObject congratulations - if (timer == 0) - then funExit - else (setGameAttribute (GA (timer - 1) remainingFood tailSize previousHeadPos score)) - _ -> do + (GA timer remainingFood tailSize previousHeadPos score) <- getGameAttribute + gState <- getGameState + case gState of + LevelStart n -> case n of + 4 -> do + congratulations <- findObject "congratulations" "messages" + drawObject congratulations + if (timer == 0) + then funExit + else (setGameAttribute (GA (timer - 1) remainingFood tailSize previousHeadPos score)) + _ -> do + disableGameFlags + level <- findObject ("level" ++ (show n)) "messages" + drawObject level + if (timer == 0) + then (do setGameState (Level n) + enableGameFlags + snakeHead <- findObject "head" "head" + setObjectAsleep False snakeHead + setObjectPosition initPos snakeHead + setObjectSpeed (0.0,speedMod) snakeHead + setObjectCurrentPicture 5 snakeHead + setGameAttribute (GA defaultTimer remainingFood tailSize previousHeadPos score) + destroyObject level + setNewMap n) + else setGameAttribute (GA (timer - 1) remainingFood tailSize previousHeadPos score) + Level n -> do + if (remainingFood == 0) -- advance level! + then (do setGameState (LevelStart (n + 1)) + resetTails disableGameFlags - level <- findObject ("level" ++ (show n)) "messages" - drawObject level - if (timer == 0) - then (do setGameState (Level n) - enableGameFlags - snakeHead <- findObject "head" "head" - setObjectAsleep False snakeHead - setObjectPosition initPos snakeHead - setObjectSpeed (0.0,speedMod) snakeHead - setObjectCurrentPicture 5 snakeHead - setGameAttribute (GA defaultTimer remainingFood tailSize previousHeadPos score) - destroyObject level - setNewMap n) - else setGameAttribute (GA (timer - 1) remainingFood tailSize previousHeadPos score) - Level n -> do - if (remainingFood == 0) -- advance level! - then (do setGameState (LevelStart (n + 1)) - resetTails - disableGameFlags - setGameAttribute (GA timer maxFood initTailSize initPos score)) - else if (timer == 0) -- put a new food in the map - then (do food <- findObject "food" "food" - newPos <- createNewFoodPosition - setObjectPosition newPos food - newFood <- findObject "food" "food" - setObjectAsleep False newFood - setGameAttribute (GA (-1) remainingFood tailSize previousHeadPos score) - snakeHead <- findObject "head" "head" - checkSnakeCollision snakeHead - snakeHeadPosition <- getObjectPosition snakeHead - moveTail snakeHeadPosition) - else if (timer > 0) -- there is no food in the map, so decrease the food timer - then (do setGameAttribute (GA (timer - 1) remainingFood tailSize previousHeadPos score) - snakeHead <- findObject "head" "head" - checkSnakeCollision snakeHead - snakeHeadPosition <- getObjectPosition snakeHead - moveTail snakeHeadPosition) - else (do -- there is a food in the map - food <- findObject "food" "food" - snakeHead <- findObject "head" "head" - col <- objectsCollision snakeHead food - if col - then (do snakeHeadPosition <- getObjectPosition snakeHead - setGameAttribute (GA defaultTimer (remainingFood-1) (tailSize + 1) snakeHeadPosition (score + 1)) - addTail previousHeadPos - setObjectAsleep True food) - else (do checkSnakeCollision snakeHead - snakeHeadPosition <- getObjectPosition snakeHead - moveTail snakeHeadPosition)) - showScore + setGameAttribute (GA timer maxFood initTailSize initPos score)) + else if (timer == 0) -- put a new food in the map + then (do food <- findObject "food" "food" + newPos <- createNewFoodPosition + setObjectPosition newPos food + newFood <- findObject "food" "food" + setObjectAsleep False newFood + setGameAttribute (GA (-1) remainingFood tailSize previousHeadPos score) + snakeHead <- findObject "head" "head" + checkSnakeCollision snakeHead + snakeHeadPosition <- getObjectPosition snakeHead + moveTail snakeHeadPosition) + else if (timer > 0) -- there is no food in the map, so decrease the food timer + then (do setGameAttribute (GA (timer - 1) remainingFood tailSize previousHeadPos score) + snakeHead <- findObject "head" "head" + checkSnakeCollision snakeHead + snakeHeadPosition <- getObjectPosition snakeHead + moveTail snakeHeadPosition) + else (do -- there is a food in the map + food <- findObject "food" "food" + snakeHead <- findObject "head" "head" + col <- objectsCollision snakeHead food + if col + then (do snakeHeadPosition <- getObjectPosition snakeHead + setGameAttribute (GA defaultTimer (remainingFood-1) (tailSize + 1) snakeHeadPosition (score + 1)) + addTail previousHeadPos + setObjectAsleep True food) + else (do checkSnakeCollision snakeHead + snakeHeadPosition <- getObjectPosition snakeHead + moveTail snakeHeadPosition)) + showScore - GameOver -> do - disableMapDrawing - gameover <- findObject "gameover" "messages" - drawMap - drawObject gameover - if (timer == 0) - then funExit - else (setGameAttribute (GA (timer - 1) 0 0 (0,0) 0)) + GameOver -> do + disableMapDrawing + gameover <- findObject "gameover" "messages" + drawMap + drawObject gameover + if (timer == 0) + then funExit + else (setGameAttribute (GA (timer - 1) 0 0 (0,0) 0)) showScore :: WormsAction () showScore = do @@ -238,13 +241,13 @@ resetTails :: WormsAction () resetTails = do - tail0 <- findObject "tail0" "tail" - setObjectPosition tail0Pos tail0 - setObjectAttribute (Tail 0) tail0 - tail1 <- findObject "tail1" "tail" - setObjectPosition tail1Pos tail1 - setObjectAttribute (Tail 1) tail1 - resetOtherTails initTailSize + tail0 <- findObject "tail0" "tail" + setObjectPosition tail0Pos tail0 + setObjectAttribute (Tail 0) tail0 + tail1 <- findObject "tail1" "tail" + setObjectPosition tail1Pos tail1 + setObjectAttribute (Tail 1) tail1 + resetOtherTails initTailSize resetOtherTails :: Int -> WormsAction () resetOtherTails n | (n == initTailSize + maxFood) = return () @@ -254,47 +257,47 @@ addTail :: (GLdouble,GLdouble) -> WormsAction () addTail presentHeadPos = do - tails <- getObjectsFromGroup "tail" - aliveTails <- getAliveTails tails [] - asleepTail <- getAsleepTail tails - setObjectAsleep False asleepTail - setObjectPosition presentHeadPos asleepTail - setObjectAttribute (Tail 0) asleepTail - addTailNumber aliveTails + tails <- getObjectsFromGroup "tail" + aliveTails <- getAliveTails tails [] + asleepTail <- getAsleepTail tails + setObjectAsleep False asleepTail + setObjectPosition presentHeadPos asleepTail + setObjectAttribute (Tail 0) asleepTail + addTailNumber aliveTails getAliveTails :: [WormsObject] -> [WormsObject] -> WormsAction [WormsObject] getAliveTails [] t = return t getAliveTails (o:os) t = do - sleeping <- getObjectAsleep o - if sleeping - then getAliveTails os t - else getAliveTails os (o:t) + sleeping <- getObjectAsleep o + if sleeping + then getAliveTails os t + else getAliveTails os (o:t) getAsleepTail :: [WormsObject] -> WormsAction WormsObject getAsleepTail [] = error "the impossible has happened!" getAsleepTail (o:os) = do - sleeping <- getObjectAsleep o - if sleeping - then return o - else getAsleepTail os + sleeping <- getObjectAsleep o + if sleeping + then return o + else getAsleepTail os addTailNumber :: [WormsObject] -> WormsAction () addTailNumber [] = return () addTailNumber (a:as) = do - (Tail n) <- getObjectAttribute a - setObjectAttribute (Tail (n + 1)) a - addTailNumber as + (Tail n) <- getObjectAttribute a + setObjectAttribute (Tail (n + 1)) a + addTailNumber as moveTail :: (GLdouble,GLdouble) -> WormsAction () moveTail presentHeadPos = do - (GA timer remainingFood tailSize previousHeadPos score) <- getGameAttribute - tails <- getObjectsFromGroup "tail" - aliveTails <- getAliveTails tails [] - lastTail <- findLastTail aliveTails - setObjectPosition previousHeadPos lastTail - setGameAttribute (GA timer remainingFood tailSize presentHeadPos score) - changeTailsAttribute tailSize aliveTails + (GA timer remainingFood tailSize previousHeadPos score) <- getGameAttribute + tails <- getObjectsFromGroup "tail" + aliveTails <- getAliveTails tails [] + lastTail <- findLastTail aliveTails + setObjectPosition previousHeadPos lastTail + setGameAttribute (GA timer remainingFood tailSize presentHeadPos score) + changeTailsAttribute tailSize aliveTails findLastTail :: [WormsObject] -> WormsAction WormsObject findLastTail [] = error "the impossible has happened!" @@ -308,39 +311,39 @@ changeTailsAttribute :: Int -> [WormsObject] -> WormsAction () changeTailsAttribute _ [] = return () changeTailsAttribute tailSize (a:as) = do - Tail n <- getObjectAttribute a - setObjectAttribute (Tail (mod (n + 1) tailSize)) a - changeTailsAttribute tailSize as + Tail n <- getObjectAttribute a + setObjectAttribute (Tail (mod (n + 1) tailSize)) a + changeTailsAttribute tailSize as checkSnakeCollision :: WormsObject -> WormsAction () checkSnakeCollision snakeHead = do - headPos <- getObjectPosition snakeHead - tile <- getTileFromWindowPosition headPos - tails <- getObjectsFromGroup "tail" - col <- objectListObjectCollision tails snakeHead - if ( (getTileBlocked tile) || col) - then (do setGameState GameOver - disableObjectsDrawing - disableObjectsMoving - setGameAttribute (GA defaultTimer 0 0 (0,0) 0)) - else return () + headPos <- getObjectPosition snakeHead + tile <- getTileFromWindowPosition headPos + tails <- getObjectsFromGroup "tail" + col <- objectListObjectCollision tails snakeHead + if ( (getTileBlocked tile) || col) + then (do setGameState GameOver + disableObjectsDrawing + disableObjectsMoving + setGameAttribute (GA defaultTimer 0 0 (0,0) 0)) + else return () createNewFoodPosition :: WormsAction (GLdouble,GLdouble) createNewFoodPosition = do - x <- randomInt (1,18) - y <- randomInt (1,24) - mapPositionOk <- checkMapPosition (x,y) - tails <- getObjectsFromGroup "tail" - tailPositionNotOk <- pointsObjectListCollision (toPixelCoord y) (toPixelCoord x) tileSize tileSize tails - if (mapPositionOk && not tailPositionNotOk) - then (return (toPixelCoord y,toPixelCoord x)) - else createNewFoodPosition - where toPixelCoord a = (tileSize/2) + (fromIntegral a) * tileSize + x <- randomInt (1,18) + y <- randomInt (1,24) + mapPositionOk <- checkMapPosition (x,y) + tails <- getObjectsFromGroup "tail" + tailPositionNotOk <- pointsObjectListCollision (toPixelCoord y) (toPixelCoord x) tileSize tileSize tails + if (mapPositionOk && not tailPositionNotOk) + then (return (toPixelCoord y,toPixelCoord x)) + else createNewFoodPosition + where toPixelCoord a = (tileSize/2) + (fromIntegral a) * tileSize checkMapPosition :: (Int,Int) -> WormsAction Bool checkMapPosition (x,y) = do - mapTile <- getTileFromIndex (x,y) - return (not (getTileBlocked mapTile)) + mapTile <- getTileFromIndex (x,y) + return (not (getTileBlocked mapTile)) b,f,g,h,i,j :: WormsTile b = (border1, True, 0.0, NoTileAttribute) @@ -351,67 +354,67 @@ j = (free3, False, 0.0, NoTileAttribute) map1 :: WormsMap -map1 = [ [b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], - [b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b]] +map1 = [[b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,f,b], + [b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b,b]] map2 :: WormsMap -map2 = [ [g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,g,g,g,g,g,g,g,g,g,g,g,g,g,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,g,g,g,g,g,g,g,g,g,g,g,g,g,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], - [g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g]] +map2 = [[g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,g,g,g,g,g,g,g,g,g,g,g,g,g,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,g,g,g,g,g,g,g,g,g,g,g,g,g,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,h,g], + [g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g,g]] map3 :: WormsMap -map3 = [ [i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i], - [i,j,j,j,j,j,j,i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], - [i,j,j,j,j,i,i,i,i,i,i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,j,j,j,j,j,j,i,i,i,i,i,i,i,j,j,j,j,j,i], - [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i,j,j,j,j,j,j,j,i], - [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i,j,j,j,j,j,j,j,i], - [i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i]] +map3 = [[i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i], + [i,j,j,j,j,j,j,i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], + [i,j,j,j,j,i,i,i,i,i,i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,j,j,j,j,j,j,i,i,i,i,i,i,i,j,j,j,j,j,i], + [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i,j,j,j,j,j,j,j,i], + [i,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,j,i,j,j,j,j,j,j,j,i], + [i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i]]