neocturne/htanks
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Simplified texture and model loading; also use crosshair for DefaultPlayer

Browse source
This commit is contained in:
Matthias Schiffer 2010-04-12 16:17:41 +02:00
parent dafe16f191
commit 08762ddc9a
7 changed files with 55 additions and 54 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
htanks.cabal
View file

@ -16,5 +16,4 @@ hs-source-dirs: src
main-is: HTanks.hs main-is: HTanks.hs
other-modules: Collision, CPUPlayer, DefaultPlayer, HWiidPlayer, Game, GLDriver, GLX, Level, MainLoop, Paths_htanks, Player, Render, Simulation, Texture, Debris, other-modules: Collision, CPUPlayer, DefaultPlayer, HWiidPlayer, Game, GLDriver, GLX, Level, MainLoop, Paths_htanks, Player, Render, Simulation, Texture, Debris,
Tank, Model, Bindings.GLX, Bindings.GLPng Tank, Model, Bindings.GLX, Bindings.GLPng
--ghc-options: -threaded
extra-libraries: glpng extra-libraries: glpng

22
src/DefaultPlayer.hs
View file

@ -8,12 +8,17 @@ import qualified Data.Set as S
import Data.Fixed import Data.Fixed
import Data.Ratio ((%)) import Data.Ratio ((%))
import Data.Typeable import Data.Typeable
import Graphics.Rendering.OpenGL.GL (GLfloat, Vector3(..))
import Graphics.Rendering.OpenGL.GL.BeginEnd (unsafeRenderPrimitive, PrimitiveMode(..))
import Graphics.Rendering.OpenGL.GL.CoordTrans (unsafePreservingMatrix, translate, rotate)
import Graphics.Rendering.OpenGL.GL.VertexSpec
import Tank import Tank
import GLDriver import GLDriver
import Player import Player
data DefaultPlayer = DefaultPlayer (S.Set Key) Float Float Bool data DefaultPlayer = DefaultPlayer (S.Set Key) Float Float Bool
deriving (Typeable, Show) deriving (Typeable, Show)
@ -34,3 +39,20 @@ instance Player DefaultPlayer where
| Just (MouseMotionEvent x y) <- fromEvent ev = DefaultPlayer keys x y shoot | Just (MouseMotionEvent x y) <- fromEvent ev = DefaultPlayer keys x y shoot
| Just (MousePressEvent x y) <- fromEvent ev = DefaultPlayer keys x y True | Just (MousePressEvent x y) <- fromEvent ev = DefaultPlayer keys x y True
| otherwise = DefaultPlayer keys aimx aimy shoot | otherwise = DefaultPlayer keys aimx aimy shoot
renderPlayer (DefaultPlayer _ aimx aimy _) = unsafePreservingMatrix $ do
translate $ Vector3 aimx aimy (0.2 :: GLfloat)
rotate 30 $ Vector3 1 0 (0 :: GLfloat)
unsafeRenderPrimitive Quads $ do
texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex2 (-0.2 :: GLfloat) (-0.2 :: GLfloat)
texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat)
vertex $ Vertex2 (-0.2 :: GLfloat) (0.2 :: GLfloat)
texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat)
vertex $ Vertex2 (0.2 :: GLfloat) (0.2 :: GLfloat)
texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex2 (0.2 :: GLfloat) (-0.2 :: GLfloat)

14
src/GLX.hs
View file

@ -15,10 +15,11 @@ import Graphics.Rendering.OpenGL.GL.CoordTrans (matrixMode, MatrixMode(..), view
import Graphics.X11.Types import Graphics.X11.Types
import Graphics.X11.Xlib.Atom (internAtom) import Graphics.X11.Xlib.Atom (internAtom)
import Graphics.X11.Xlib.Display (defaultScreen, openDisplay, rootWindow) import Graphics.X11.Xlib.Color (queryColor)
import Graphics.X11.Xlib.Event (XEventPtr, allocaXEvent, nextEvent, get_Window, get_EventType, pending) import Graphics.X11.Xlib.Display (defaultScreen, openDisplay, rootWindow, whitePixel)
import Graphics.X11.Xlib.Event (XEventPtr, allocaXEvent, nextEvent, get_Window, get_EventType, pending, sync)
import Graphics.X11.Xlib.Extras (ClassHint(..), getEvent, ev_event_type, ev_width, ev_height, ev_keycode, ev_data, ev_x, ev_y, getWindowAttributes, wa_width, wa_height) import Graphics.X11.Xlib.Extras (ClassHint(..), getEvent, ev_event_type, ev_width, ev_height, ev_keycode, ev_data, ev_x, ev_y, getWindowAttributes, wa_width, wa_height)
import Graphics.X11.Xlib.Misc (keycodeToKeysym, setWMProtocols) import Graphics.X11.Xlib.Misc (keycodeToKeysym, setWMProtocols, createPixmap, createPixmapCursor, defineCursor)
import Graphics.X11.Xlib.Types import Graphics.X11.Xlib.Types
import Graphics.X11.Xlib.Window (destroyWindow, mapWindow, storeName) import Graphics.X11.Xlib.Window (destroyWindow, mapWindow, storeName)
@ -78,12 +79,19 @@ instance Driver GLX where
setClassHint disp wnd (ClassHint "HTanks" "htanks") setClassHint disp wnd (ClassHint "HTanks" "htanks")
setWMProtocols disp wnd [delwnd] setWMProtocols disp wnd [delwnd]
color <- queryColor disp cmap $ Graphics.X11.Xlib.Types.Color (whitePixel disp $ fromIntegral . viScreen $ visualinfo) 0 0 0 0
pixmap <- createPixmap disp wnd 1 1 1
cursor <- createPixmapCursor disp pixmap pixmap color color 0 0
sync disp False
storeName disp wnd "HTanks" storeName disp wnd "HTanks"
mapWindow disp wnd mapWindow disp wnd
waitForMapNotify disp wnd waitForMapNotify disp wnd
defineCursor disp wnd cursor
ctx <- with visualinfo $ \vi -> createContext disp vi (Context nullPtr) True ctx <- with visualinfo $ \vi -> createContext disp vi (Context nullPtr) True
makeCurrent disp wnd ctx makeCurrent disp wnd ctx

6
src/HTanks.hs
View file

@ -27,7 +27,7 @@ import Data.Obj3D.GL
main :: IO () main :: IO ()
main = do main = do
let theLevel = testLevel let theLevel = testLevel
hwiidPlayer <- newHWiidPlayer --hwiidPlayer <- newHWiidPlayer
gl <- initGL $ glxDriver (levelWidth theLevel) (levelHeight theLevel) gl <- initGL $ glxDriver (levelWidth theLevel) (levelHeight theLevel)
when (initialized gl) $ do when (initialized gl) $ do
@ -36,8 +36,8 @@ main = do
, Tank 5.0 3.5 0 0 1.5 270 False 3 1 5 1 , Tank 5.0 3.5 0 0 1.5 270 False 3 1 5 1
], bullets = []} ], bullets = []}
mainstate = MainState {run = True, driver = SomeDriver gl, time = currentTime, players = mainstate = MainState {run = True, driver = SomeDriver gl, time = currentTime, players =
[ --SomePlayer $ DefaultPlayer S.empty 0 0 False [ SomePlayer $ DefaultPlayer S.empty 0 0 False
SomePlayer $ hwiidPlayer --SomePlayer $ hwiidPlayer
, SomePlayer $ CPUPlayer 0 , SomePlayer $ CPUPlayer 0
], textures = M.empty, models = M.empty, gameState = gamestate} ], textures = M.empty, models = M.empty, gameState = gamestate}

7
src/Model.hs
View file

@ -1,8 +1,15 @@
module Model ( Model(..) module Model ( Model(..)
, InterleavedObj , InterleavedObj
, modelPath
) where ) where
import Paths_htanks
import Data.Obj3D.GL (InterleavedObj) import Data.Obj3D.GL (InterleavedObj)
data Model = ModelTank data Model = ModelTank
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
modelPath :: Model -> IO FilePath
modelPath t = getDataFileName $ "model/" ++ (name t) ++ ".obj"
where
name ModelTank = "tank"

48
src/Render.hs
View file

@ -3,7 +3,6 @@ module Render ( setup
) where ) where
import Paths_htanks
import Game import Game
import MainLoop import MainLoop
import Level import Level
@ -36,18 +35,6 @@ import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureTarget(..))
import Graphics.Rendering.OpenGL.GL.VertexArrays (clientState, ClientArrayType(..)) import Graphics.Rendering.OpenGL.GL.VertexArrays (clientState, ClientArrayType(..))
import Graphics.Rendering.OpenGL.GL.VertexSpec import Graphics.Rendering.OpenGL.GL.VertexSpec
import Foreign.ForeignPtr
import Foreign.Marshal.Array
texturePath :: Texture -> IO FilePath
texturePath t = getDataFileName $ path t
where
path TextureWood = "tex/Wood.png"
path TextureTank = "tex/Tank.png"
path TextureCannon = "tex/Cannon.png"
path TextureBullet = "tex/Bullet.png"
path TextureCrosshair = "tex/Crosshair.png"
getTexture :: Texture -> Main TextureObject getTexture :: Texture -> Main TextureObject
getTexture t = do getTexture t = do
@ -63,11 +50,6 @@ getTexture t = do
modify $ \state -> state {textures = M.insert t tex ts} modify $ \state -> state {textures = M.insert t tex ts}
return tex return tex
modelPath :: Model -> IO FilePath
modelPath t = getDataFileName $ path t
where
path ModelTank = "model/tank.obj"
getModel :: Model -> Main InterleavedObj getModel :: Model -> Main InterleavedObj
getModel m = do getModel m = do
ms <- gets models ms <- gets models
@ -176,19 +158,6 @@ render = do
rotate 90 $ Vector3 1 0 (0 :: GLfloat) rotate 90 $ Vector3 1 0 (0 :: GLfloat)
drawObject modelTank 1 drawObject modelTank 1
{-unsafeRenderPrimitive Quads $ do
texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex2 (-0.5 :: GLfloat) (-0.5 :: GLfloat)
texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat)
vertex $ Vertex2 (-0.5 :: GLfloat) (0.5 :: GLfloat)
texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat)
vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat)
texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat)-}
rotate (rotAim-rotDir) $ Vector3 0 0 (1 :: GLfloat) rotate (rotAim-rotDir) $ Vector3 0 0 (1 :: GLfloat)
--textureBinding Texture2D $= Just textureCannon --textureBinding Texture2D $= Just textureCannon
@ -197,21 +166,6 @@ render = do
rotate 90 $ Vector3 1 0 (0 :: GLfloat) rotate 90 $ Vector3 1 0 (0 :: GLfloat)
drawObject modelTank 0 drawObject modelTank 0
{-unsafeRenderPrimitive Quads $ do
texCoord $ TexCoord2 (0 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex2 (-0.5 :: GLfloat) (-0.5 :: GLfloat)
texCoord $ TexCoord2 (0 :: GLfloat) (1 :: GLfloat)
vertex $ Vertex2 (-0.5 :: GLfloat) (0.5 :: GLfloat)
texCoord $ TexCoord2 (1 :: GLfloat) (1 :: GLfloat)
vertex $ Vertex2 (0.5 :: GLfloat) (0.5 :: GLfloat)
texCoord $ TexCoord2 (1 :: GLfloat) (0 :: GLfloat)
vertex $ Vertex2 (0.5 :: GLfloat) (-0.5 :: GLfloat)-}
texture Texture2D $= Enabled texture Texture2D $= Enabled
forM_ bulletlist $ \bullet -> unsafePreservingMatrix $ do forM_ bulletlist $ \bullet -> unsafePreservingMatrix $ do
@ -219,7 +173,7 @@ render = do
y = realToFrac . bulletY $ bullet y = realToFrac . bulletY $ bullet
rotDir = realToFrac . bulletDir $ bullet rotDir = realToFrac . bulletDir $ bullet
translate $ Vector3 x y (0.1 :: GLfloat) translate $ Vector3 x y (0.2 :: GLfloat)
rotate 30 $ Vector3 1 0 (0 :: GLfloat) rotate 30 $ Vector3 1 0 (0 :: GLfloat)
rotate rotDir $ Vector3 0 0 (1 :: GLfloat) rotate rotDir $ Vector3 0 0 (1 :: GLfloat)

11
src/Texture.hs
View file

@ -1,8 +1,19 @@
module Texture ( Texture(..) module Texture ( Texture(..)
, TextureObject , TextureObject
, texturePath
) where ) where
import Paths_htanks
import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject) import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject)
data Texture = TextureWood | TextureTank | TextureCannon | TextureBullet | TextureCrosshair data Texture = TextureWood | TextureTank | TextureCannon | TextureBullet | TextureCrosshair
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
texturePath :: Texture -> IO FilePath
texturePath t = getDataFileName $ "tex/" ++ (name t) ++ ".png"
where
name TextureWood = "Wood"
name TextureTank = "Tank"
name TextureCannon = "Cannon"
name TextureBullet = "Bullet"
name TextureCrosshair = "Crosshair"