Simplified texture and model loading; also use crosshair for DefaultPlayer

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"