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
other-modules: Collision, CPUPlayer, DefaultPlayer, HWiidPlayer, Game, GLDriver, GLX, Level, MainLoop, Paths_htanks, Player, Render, Simulation, Texture, Debris,
Tank, Model, Bindings.GLX, Bindings.GLPng
--ghc-options: -threaded
extra-libraries: glpng

22
src/DefaultPlayer.hs
View file

@ -8,12 +8,17 @@ import qualified Data.Set as S
import Data.Fixed
import Data.Ratio ((%))
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 GLDriver
import Player
data DefaultPlayer = DefaultPlayer (S.Set Key) Float Float Bool
deriving (Typeable, Show)
@ -34,3 +39,20 @@ instance Player DefaultPlayer where
| Just (MouseMotionEvent x y) <- fromEvent ev = DefaultPlayer keys x y shoot
| Just (MousePressEvent x y) <- fromEvent ev = DefaultPlayer keys x y True
| 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.Xlib.Atom (internAtom)
import Graphics.X11.Xlib.Display (defaultScreen, openDisplay, rootWindow)
import Graphics.X11.Xlib.Event (XEventPtr, allocaXEvent, nextEvent, get_Window, get_EventType, pending)
import Graphics.X11.Xlib.Color (queryColor)
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.Misc (keycodeToKeysym, setWMProtocols)
import Graphics.X11.Xlib.Misc (keycodeToKeysym, setWMProtocols, createPixmap, createPixmapCursor, defineCursor)
import Graphics.X11.Xlib.Types
import Graphics.X11.Xlib.Window (destroyWindow, mapWindow, storeName)
@ -78,12 +79,19 @@ instance Driver GLX where
setClassHint disp wnd (ClassHint "HTanks" "htanks")
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"
mapWindow disp wnd
waitForMapNotify disp wnd
defineCursor disp wnd cursor
ctx <- with visualinfo $ \vi -> createContext disp vi (Context nullPtr) True
makeCurrent disp wnd ctx

6
src/HTanks.hs
View file

@ -27,7 +27,7 @@ import Data.Obj3D.GL
main :: IO ()
main = do
let theLevel = testLevel
hwiidPlayer <- newHWiidPlayer
--hwiidPlayer <- newHWiidPlayer
gl <- initGL $ glxDriver (levelWidth theLevel) (levelHeight theLevel)
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
], bullets = []}
mainstate = MainState {run = True, driver = SomeDriver gl, time = currentTime, players =
[ --SomePlayer $ DefaultPlayer S.empty 0 0 False
SomePlayer $ hwiidPlayer
[ SomePlayer $ DefaultPlayer S.empty 0 0 False
--SomePlayer $ hwiidPlayer
, SomePlayer $ CPUPlayer 0
], textures = M.empty, models = M.empty, gameState = gamestate}

7
src/Model.hs
View file

@ -1,8 +1,15 @@
module Model ( Model(..)
, InterleavedObj
, modelPath
) where
import Paths_htanks
import Data.Obj3D.GL (InterleavedObj)
data Model = ModelTank
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
import Paths_htanks
import Game
import MainLoop
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.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 t = do
@ -63,11 +50,6 @@ getTexture t = do
modify $ \state -> state {textures = M.insert t tex ts}
return tex
modelPath :: Model -> IO FilePath
modelPath t = getDataFileName $ path t
where
path ModelTank = "model/tank.obj"
getModel :: Model -> Main InterleavedObj
getModel m = do
ms <- gets models
@ -176,19 +158,6 @@ render = do
rotate 90 $ Vector3 1 0 (0 :: GLfloat)
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)
--textureBinding Texture2D $= Just textureCannon
@ -196,22 +165,7 @@ render = do
unsafePreservingMatrix $ do
rotate 90 $ Vector3 1 0 (0 :: GLfloat)
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
forM_ bulletlist $ \bullet -> unsafePreservingMatrix $ do
@ -219,7 +173,7 @@ render = do
y = realToFrac . bulletY $ 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 rotDir $ Vector3 0 0 (1 :: GLfloat)

11
src/Texture.hs
View file

@ -1,8 +1,19 @@
module Texture ( Texture(..)
, TextureObject
, texturePath
) where
import Paths_htanks
import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject)
data Texture = TextureWood | TextureTank | TextureCannon | TextureBullet | TextureCrosshair
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"