Shu-thing (empty) → 1.0.20071203
raw patch · 4 files changed
+489/−0 lines, 4 filesdep +GLUTdep +basesetup-changed
Dependencies added: GLUT, base
Files
- LICENSE +23/−0
- Setup.lhs +4/−0
- Shu-thing.cabal +18/−0
- Shu-thing.hs +444/−0
+ LICENSE view
@@ -0,0 +1,23 @@+Copyright 2005 Hideyuki Tanaka & Takayuki Muranushi. All rights reserved.++Redistribution and use in source and binary forms,+with or without modification, are permitted provided that+the following conditions are met:++ 1. Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++ 2. 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.++THIS SOFTWARE IS PROVIDED ``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 REGENTS 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.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ Shu-thing.cabal view
@@ -0,0 +1,18 @@+name: Shu-thing+version: 1.0.20071203+synopsis: A vector shooter game+description: A 2-D vector graphics upwards-scrolling keyboard-controlled shooter.+ You shoot the enemies while dodging their bullets until you reach and defeat the enemy.+category: Game+license: BSD3+license-file: LICENSE+author: Hideyuki Tanaka & Takayuki Muranushi+maintainer: Takayuki Muranushi <muranushi@gmail.com>, <gwern0@gmail.com>+build-depends: base, GLUT+build-type: Simple++executable: shu-thing+main-is: Shu-thing.hs+ghc-options: -O2 -funbox-strict-fields -Wall -Werror -optl-Wl,-s+ghc-prof-options: -prof -auto-all+extensions: BangPatterns
+ Shu-thing.hs view
@@ -0,0 +1,444 @@+{-# OPTIONS_GHC -fbang-patterns #-} +module Main (main) + where + +import Control.Exception (Exception(ExitException), catch, throwIO) +import Control.Monad (zipWithM_) +import Data.IORef (IORef, modifyIORef, newIORef, readIORef, writeIORef) +import Data.List (nub) +import Data.Maybe (isJust, fromJust) +import Graphics.UI.GLUT (DisplayMode(RGBMode, DoubleBuffered), + getArgsAndInitialize, initialDisplayMode, initialWindowSize, mainLoop, + createWindow, destroyWindow, swapBuffers, Menu(..), MenuItem(MenuEntry), + attachMenu, Font(renderString), StrokeFont(Roman), Flavour(Wireframe), + Object(Tetrahedron, Teapot, Octahedron, Icosahedron, Dodecahedron), + renderObject, MouseButton(LeftButton,RightButton), Key(SpecialKey, Char), KeyState(..), + SpecialKey(KeyUp, KeyRight, KeyLeft, KeyDown), displayCallback, + keyboardMouseCallback, TimerCallback, addTimerCallback, MatrixComponent(..), + MatrixMode(Projection, Modelview), Position(..), Size(..), Vector3(..), + loadIdentity, matrixMode, preservingMatrix, viewport, + ClearBuffer(DepthBuffer, ColorBuffer), clear, HasSetter(..), lookAt, + perspective, Color(color), Color3(..), Vertex3(..)) +import Prelude hiding (catch) +import System.Exit (ExitCode(ExitSuccess)) + +main :: IO () +main = do + keystate <- newIORef [] + cp <- newIORef $ openingProc keystate + initialWindowSize $= Size 1200 800 + initialDisplayMode $= [RGBMode,DoubleBuffered] + getArgsAndInitialize + wnd <- createWindow "Shu-thing" + + displayCallback $= dispProc cp + keyboardMouseCallback $= Just (keyProc keystate) + + addTimerCallback 24 $ timerProc $ dispProc cp + + attachMenu LeftButton (Menu [ + MenuEntry "&Exit" exitLoop]) + attachMenu RightButton (Menu [ + MenuEntry "&Exit" exitLoop]) + + initMatrix + mainLoop + destroyWindow wnd + + `catch` (\_ -> return ()) + +exitLoop :: IO a +exitLoop = throwIO $ ExitException ExitSuccess + +initMatrix :: IO () +initMatrix = do + viewport $= (Position 0 0,Size 1200 800) + matrixMode $= Projection + loadIdentity + perspective 30.0 (4/3) 600 1400 + lookAt (Vertex3 0 0 (927 :: Double)) (Vertex3 0 0 (0 :: Double)) (Vector3 0 1 (0 :: Double)) + +dispProc :: IORef (IO Scene) -> IO () +dispProc !cp = do + m <- readIORef cp + Scene next <- m + writeIORef cp next + +data Scene = Scene (IO Scene) + +openingProc :: IORef [Key] -> IO Scene +openingProc !ks = do + keystate <- readIORef ks + + clear [ColorBuffer,DepthBuffer] + matrixMode $= Modelview 0 + loadIdentity + + color $ Color3 (1.0 :: Double) 1.0 1.0 + preservingMatrix $ do + translate $ Vector3 (-250 :: Double) 0 0 + scale (0.8 :: Double) 0.8 0.8 + renderString Roman "shu-thing" + preservingMatrix $ do + translate $ Vector3 (-180 :: Double) (-100) 0 + scale (0.4 :: Double) 0.4 0.4 + renderString Roman "Press Z key" + + swapBuffers + + if Char 'z' `elem` keystate then do + gs <- newIORef initialGameState + return $ Scene $ mainProc gs ks + else return $ Scene $ openingProc ks + +endingProc :: IORef [Key] -> IORef Double -> IO Scene +endingProc !ks !ctr= do + keystate <- readIORef ks + counter <- readIORef ctr + modifyIORef ctr $ min 2420 . (+1.5) + clear [ColorBuffer,DepthBuffer] + matrixMode $= Modelview 0 + loadIdentity + + color $ Color3 (1.0 :: Double) 1.0 1.0 + zipWithM_ (\str pos -> preservingMatrix $ do + translate $ Vector3 (-180 :: Double) (-240+counter-pos) 0 + scale (0.3 :: Double) 0.3 0.3 + renderString Roman str) + stuffRoll [0,60..] + + swapBuffers + + if Char 'x' `elem` keystate then do + return $ Scene $ openingProc ks + else return $ Scene $ endingProc ks ctr + + where + stuffRoll = [ + "", + "Game Design", + " T. Muranushi", + "", + "Main Programmer", + " H. Tanaka", + "", + "Enemy Algorithm", + " M. Takayuki", + "", + "Graphics Designer", + " Euclid", + "", + "Monad Designer", + " tanakh", + "", + "Lazy Evaluator", + " GHC 6.8", + "", + "Cast", + " Player Dodecahedron", + " Bullet Tetrahedron", + " Enemy Octahedron", + " Boss Teapot", + "", + "Special thanks to", + " Simon Marlow", + " Haskell B. Curry", + "", + "Presented by", + " team combat", + "", + "WE LOVE HASKELL!", + "", + " press x key"] + +mainProc :: IORef GameState -> IORef [Key] -> IO Scene +mainProc !gs !ks = do + keystate <- readIORef ks + modifyIORef gs $ updateGameState keystate + gamestate <- readIORef gs + + clear [ColorBuffer,DepthBuffer] + matrixMode $= Modelview 0 + loadIdentity + renderGameState gamestate + swapBuffers + if (isGameover gamestate) then return $ Scene $ openingProc ks else + if (isClear gamestate) then do + counter <- newIORef (0.0 :: Double) + return $ Scene $ endingProc ks counter else + return $ Scene $ mainProc gs ks + +timerProc :: IO a -> TimerCallback +timerProc m = m >> addTimerCallback 16 (timerProc m) + +keyProc :: IORef [Key] -> Key -> KeyState -> t -> t1 -> IO () +keyProc keystate !key !ks _ _ = + case (key,ks) of + (Char 'q',_) -> exitLoop + (Char 'c',_) -> exitLoop + (_,Down) -> modifyIORef keystate $ nub . (++[key]) + (_,Up) -> modifyIORef keystate $ filter (/=key) + +bosstime, bosstime2 :: Int +bosstime = 6600 +bosstime2 = 7200 + +data GameObject = Player {position :: !Point,shotEnergy :: !Double,hp :: !Double}| + Bullet {position :: !Point} | + EnemyMaker {timer :: !Int,deathtimer :: !Int}| + Enemy {position :: !Point,hp :: !Double,anime :: !Int,enemySpec :: !EnemySpec} | + Explosion {position :: !Point,hp :: !Double,size :: !Double}| + EnemyBullet {position :: !Point,velocity :: !Point} | + GameoverSignal | + ClearSignal + deriving (Eq) + +data EnemySpec = EnemySpec {ways :: !Int,spread :: !Double,speed :: !Double,freq :: !Int,endurance :: !Double,boss :: !Bool} + deriving (Eq) + +updateObject :: GameState -> [Key] -> GameObject -> [GameObject] +updateObject _ !ks (!Player{position=pos,shotEnergy=sen,hp=oldhp}) + = [(Player{position=newPos,shotEnergy=nsen,hp=newhp})] ++ shots + where + newPos :: Point + newPos = if (oldhp > 0) then (nx,ny) +++ v + else (nx,ny) + newhp = oldhp + (x,y) = pos + nx = if (x < (-310)) then -310 else if (x > 310) then 310 else x + ny = if (y < (-230)) then -230 else if (y > 200) then 200 else y + v = (vx,vy) *++ (5.0 :: Double) + shots = replicate shotn $ Bullet pos + nsen = if (shotn /= 0) then (-1.0) else + if (shotmode == 1 && shotn == 0) then (sen+0.25) else + if(shotmode == 0) then 0.0 else + sen + vx :: Double + vx = + if ((SpecialKey KeyLeft) `elem` ks) then -1 else 0 + + if ((SpecialKey KeyRight) `elem` ks) then 1 else 0 + vy = + if ((SpecialKey KeyUp) `elem` ks) then 1 else 0 + + if ((SpecialKey KeyDown) `elem` ks) then -1 else 0 + shotmode :: Int + shotmode = + if ((Char 'z') `elem` ks) then 1 else 0 + shotn :: Int + shotn = if (oldhp <= 0) then 0 else if (shotmode == 0) then 0 else + if (sen >= 0) then 1 else 0 +updateObject _ _ (!Bullet{position=pos}) = replicate n (Bullet newpos) where + newpos = pos +++ (0.0,15.0) + n = if( (\(_,y) -> y > 250) pos)then 0 else 1 +updateObject !gs _ (!EnemyMaker{timer=t,deathtimer=dtime}) = + [EnemyMaker{timer=t+1,deathtimer=newdtime}] ++ enemies ++ deatheffects where + enemies = replicate n $ Enemy{position = (320*sin(dt*dt),240),hp=1.0,anime=0,enemySpec = spec} + dt :: Double + dt = fromIntegral t + newdtime = dtime + if (hp p<=0 || (bossExist&&hp b<=0)) then 1 else 0 + n = if((t`mod`120==0 && t<=bosstime) || t==bosstime2) then 1 else 0 + deatheffects = if(dtime==0) then [] else + if(dtime==120) then [Explosion{position=position deadone,hp=1.0,size=3.0*deathradius}] else + if(dtime==130) then [Explosion{position=position deadone,hp=1.0,size=3.0*deathradius}] else + if(dtime==140) then [Explosion{position=position deadone,hp=1.0,size=3.0*deathradius}] else + if(dtime==240) then [if(hp p<=0) then GameoverSignal else ClearSignal] else + if(dtime>120) then [] else + if(dtime`mod`15/=0)then [] else + [Explosion{position=position deadone +++ ((sin(dt),cos(dt))*++ (16*deathradius)),hp=1.0,size=0.3*deathradius}] + p = findplayer gs + b = fromJust mayb + deadone :: GameObject + deadone = if(hp p<=0) then p else b + deathradius = if(hp p<=0) then 1 else 3 + bossExist = isJust mayb + mayb = findBoss gs + spec = if(t==bosstime2) then (EnemySpec{ways=0,spread=0.1,speed=3.0,freq=10,endurance=300.0,boss=True}) + else speclist !! (t `div` 600) + speclist = [ + EnemySpec {ways=0,spread=0.1,speed=3.0,freq=30,endurance=2.0,boss=False}, + EnemySpec {ways=1,spread=0.3,speed=5.0,freq=60,endurance=4.0,boss=False}, + EnemySpec {ways=3,spread=0.7,speed=0.2,freq=90,endurance=8.0,boss=False}, + EnemySpec {ways=45,spread=0.069,speed=8.0,freq=450,endurance=1.0,boss=False}, + EnemySpec {ways=0,spread=0.1,speed=1.0,freq=10,endurance=10.0,boss=False}, + EnemySpec {ways=0,spread=0.1,speed=1.0,freq=10,endurance=10.0,boss=False}, + EnemySpec {ways=3,spread=0.1,speed=3.0,freq=60,endurance=6.0,boss=False}, + EnemySpec {ways=1,spread=0.5,speed=7.0,freq=45,endurance=3.0,boss=False}, + EnemySpec {ways=(10),spread=0.3,speed=15.0,freq=115,endurance=5.0,boss=False} + ] ++ + map (\o -> EnemySpec {ways=o,spread=0.1,speed=4.0,freq=20,endurance=3.0,boss=False}) [0,1 ..] + +updateObject !gs _ !oldenemy@(Enemy{position=pos,hp=oldhp,anime=oldanime,enemySpec=spec}) = + replicate n (oldenemy{position=newpos,hp=newhp,anime=newanime,enemySpec=newspec}) + ++ shots ++ explosions where + newpos = if isBoss then (200 * sin(danime/100),200 + 40 * cos(danime/80)) + else pos +++ (0.0,-1.0) + newhp = oldhp + newanime = oldanime + 1 + newspec = if(not isBoss) then spec else + if (oldhp>0.75) then EnemySpec{ways=0,spread=0.1,speed=5.0,freq=10,endurance=300.0,boss=True} else + if (oldhp>0.50) then EnemySpec{ways=8,spread=0.15,speed=3.0,freq=30,endurance=300.0,boss=True} else + if (oldhp>0.25) then EnemySpec{ways=2,spread=1.2,speed=15.0,freq=10,endurance=300.0,boss=True} else + if (oldhp>0.05) then EnemySpec{ways=40,spread=0.075,speed=3.0,freq=60,endurance=400.0,boss=True} else + if (oldhp>0.00) then EnemySpec{ways=15,spread=0.2,speed=16.0,freq=20,endurance=900.0,boss=True} else + EnemySpec{ways=(-1),spread=0.1,speed=3.0,freq=10,endurance=300.0,boss=True} + danime :: Double + danime = fromIntegral oldanime + explosions = if(oldhp<=0 && not isBoss) then [Explosion{position=pos,hp=1.0,size=1.0}] else [] + shots = if(oldanime`mod` frq /=(frq-1)) then [] else + map (\v -> EnemyBullet{position=pos,velocity=v}) vs + vs = (take (wa+1) $ iterate (vdistr***) centerv) ++ + (take wa $ tail $ iterate (vdistrc***) centerv) + centerv = (pp -+- pos) *++ (spd / (distance pp pos)) + vdistr :: Point + vdistr = (cos(sprd),sin(sprd)) + vdistrc :: Point + vdistrc = (cos(sprd),-sin(sprd)) + pp = playerpos gs + n = if( (\(_,y) -> y<(-250)) pos || (not isBoss && oldhp<=0))then 0 else 1 + wa = ways spec + spd= speed spec + frq = freq spec + sprd= spread spec + isBoss = boss spec +updateObject _ _ !e@(Explosion{}) = if(hp e>0) then [e{hp=hp e - (0.024/(size e))}] else [] +updateObject _ _ !eb@(EnemyBullet{}) = if(outofmap (position eb)) then [] else + [eb{position=position eb+++velocity eb}] +updateObject _ _ go = [go] + +watcher :: [GameObject] -> [GameObject] +watcher os = np ++ ne ++ nb ++ neb ++ others + where + ne = foldr ($) enemies $ map enemyDamager bullets + np = foldr ($) players $ map playerDamager ebullets + nb = foldr ($) bullets $ map bulletEraser enemies + neb = foldr ($) ebullets $ map ebEraser players + bulletEraser :: GameObject -> [GameObject] -> [GameObject] + bulletEraser e = filter (\b -> (distance2 (position b) (position e)) > hitr(e)) + enemyDamager :: GameObject -> [GameObject] -> [GameObject] + enemyDamager b = map (\e -> + if ((distance2 (position b) (position e)) > hitr(e)) + then e + else (\d -> d{hp=hp d-(1.0 / (endurance (enemySpec d)))}) e) + hitr e = if(boss $ enemySpec e) then sq 100 else sq 32 + playerDamager :: GameObject -> [GameObject] -> [GameObject] + playerDamager eb = map (\p -> + if((distance2 (position p) (position eb)) > 70) + then p + else (\q -> q{hp=hp q-0.3}) p) + ebEraser p = filter (\eb -> (distance2 (position eb) (position p)) > 70) + (enemies,bullets,ebullets,players,others) = foldl f ([],[],[],[],[]) os + f (e,b,eb,p,x) o = case o of + Enemy{} -> (o:e,b,eb,p,x) + Bullet{} -> (e,o:b,eb,p,x) + EnemyBullet{} -> (e,b,o:eb,p,x) + Player{} -> (e,b,eb,o:p,x) + _ -> (e,b,eb,p,o:x) + +renderGameObject :: GameObject -> IO () +renderGameObject !Player{position=pos,hp=h} = preservingMatrix $ do + let (x,y) = pos + color (Color3 (1.0 :: Double) h h) + translate (Vector3 x y 0) + scale (10 :: Double) 10 10 + rotate (x) (Vector3 0 1 0) + rotate (30 :: Double) (Vector3 0 0 1) + renderObject Wireframe Dodecahedron +renderGameObject !Bullet{position=pos} = preservingMatrix $ do + let (x,y) = pos + color (Color3 (0.6 :: Double) 0.6 1.0) + translate (Vector3 x y 0) + scale (4 :: Double) 18 8 + rotate (45 :: Double) (Vector3 0 1 0) + rotate (90 :: Double) (Vector3 1 0 0) + renderObject Wireframe Tetrahedron +renderGameObject !Enemy{position=pos,anime=a,hp=h,enemySpec=EnemySpec{boss=False}} = preservingMatrix $ do + let (x,y) = pos + color (Color3 (cos rho) (sin rho) (0.0 :: Double)) + translate (Vector3 x y 0) + rotate (2*(theta :: Double)) (Vector3 0 1.0 0) + scale (32 :: Double) 32 8 + renderObject Wireframe Octahedron where + theta = fromIntegral a + rho = h * 3.14 / 2 +renderGameObject !Enemy{position=pos,anime=a,hp=h,enemySpec=EnemySpec{boss=True}} = preservingMatrix $ do + let (x,y) = pos + color (Color3 (cos rho) (sin rho) (0.0 :: Double)) + translate (Vector3 x y 0) + rotate (2*(theta :: Double)) (Vector3 0 1.0 0) + scale (120 :: Double) 120 120 + renderObject Wireframe (Teapot 1.0) where + theta = fromIntegral a + rho = h * 3.14 / 2 +renderGameObject !Explosion{position=pos,hp=h,size=s}= preservingMatrix $ do + let (x,y) = pos + color (Color3 h 0.0 0.0) + translate (Vector3 x y 0) + rotate (720*h) (Vector3 0 1.0 0) + rotate (540*h) (Vector3 1.0 0 0) + scale r r r + renderObject Wireframe Icosahedron where + r = s*(100 - h*h*80) +renderGameObject !EnemyBullet{position=pos} = preservingMatrix $ do + let (x,y) = pos + color (Color3 (1.0 :: Double) 1.0 1.0) + translate (Vector3 x y 0) + scale (5 :: Double) 5 5 + rotate (45 :: Double) (Vector3 0 0 (1.0 :: Double)) + renderObject Wireframe Tetrahedron +renderGameObject _ = return () + +data GameState = GameState {objects :: [GameObject]} + +initialGameState :: GameState +initialGameState = GameState{objects= + [(Player{position=(0.0,0.0),shotEnergy=0.0,hp=1.0}),(EnemyMaker{timer=0,deathtimer=0})]} + +renderGameState :: GameState -> IO () +renderGameState !GameState{objects=os} = mapM_ renderGameObject os + +updateGameState :: [Key] -> GameState -> GameState +updateGameState !ks !gs@(GameState { objects=os }) = newgs where + newgs = GameState{objects = watcher $ concatMap (updateObject gs ks) os} + +playerpos :: GameState -> Point +playerpos = position . findplayer +findplayer :: GameState -> GameObject +findplayer !GameState{objects=os} = player where + [player] = filter (\o -> case o of + Player{} -> True + _ -> False) os +findBoss :: GameState -> Maybe GameObject +findBoss GameState{objects=os} = if (length bosses==0) then Nothing + else Just (head bosses) where + bosses = filter(\o -> case o of + Enemy{} -> boss( enemySpec o) + _ -> False) os + +isGameover :: GameState -> Bool +isGameover GameState{objects=os} = (GameoverSignal `elem` os) + +isClear :: GameState -> Bool +isClear GameState{objects=os} = (ClearSignal `elem` os) + +type Point = (Double,Double) + +(+++) :: (Double, Double) -> (Double, Double) -> (Double, Double) +(ax,ay) +++ (bx,by) = (ax+bx, ay+by) + +(-+-) :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1) +(!ax,!ay) -+- (!bx,!by) = (ax-bx,ay-by) + +(*++) :: (Num t) => (t, t) -> t -> (t, t) +(!ax,!ay) *++ (!s) = (ax*s,ay*s) + +(***) :: (Num t) => (t, t) -> (t, t) -> (t, t) +(!ax,!ay) *** (!bx,!by) = (ax*bx-ay*by,ay*bx+ax*by) + +sq :: Double -> Double +sq !x = x*x + +distance, distance2 :: Point -> Point -> Double +distance a b= sqrt $ distance2 a b +distance2 !(ax,ay) !(bx,by) = sq(ax-bx) + sq(ay-by) + +outofmap :: Point -> Bool +outofmap !(x,y) = (not $ abs x < 320) || (not $ abs y < 240)