summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--htanks.cabal1
-rw-r--r--src/DefaultPlayer.hs22
-rw-r--r--src/GLX.hs14
-rw-r--r--src/HTanks.hs6
-rw-r--r--src/Model.hs7
-rw-r--r--src/Render.hs48
-rw-r--r--src/Texture.hs11
7 files changed, 55 insertions, 54 deletions
diff --git a/htanks.cabal b/htanks.cabal
index aa33d06..38c443d 100644
--- a/htanks.cabal
+++ b/htanks.cabal
@@ -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
diff --git a/src/DefaultPlayer.hs b/src/DefaultPlayer.hs
index 756ba88..7f97f39 100644
--- a/src/DefaultPlayer.hs
+++ b/src/DefaultPlayer.hs
@@ -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)
diff --git a/src/GLX.hs b/src/GLX.hs
index bc2201e..9ad6392 100644
--- a/src/GLX.hs
+++ b/src/GLX.hs
@@ -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
diff --git a/src/HTanks.hs b/src/HTanks.hs
index f1e0e98..c9525b9 100644
--- a/src/HTanks.hs
+++ b/src/HTanks.hs
@@ -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}
diff --git a/src/Model.hs b/src/Model.hs
index daec0c2..0c273e9 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -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"
diff --git a/src/Render.hs b/src/Render.hs
index 356310f..32173c1 100644
--- a/src/Render.hs
+++ b/src/Render.hs
@@ -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)
diff --git a/src/Texture.hs b/src/Texture.hs
index 1e82cdf..746456e 100644
--- a/src/Texture.hs
+++ b/src/Texture.hs
@@ -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"
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 11:45:40 +0100