summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--GLDriver.hs12
-rw-r--r--HTanks.hs69
-rw-r--r--Makefile2
-rw-r--r--Tank.hs2
-rw-r--r--tex/Tank.pngbin423 -> 537 bytes
5 files changed, 66 insertions, 19 deletions
diff --git a/GLDriver.hs b/GLDriver.hs
index 2b55c6f..44964d8 100644
--- a/GLDriver.hs
+++ b/GLDriver.hs
@@ -35,26 +35,28 @@ instance Driver SomeDriver where
nextEvent (SomeDriver d) = nextEvent d
-class Typeable a => Event a
+class (Typeable a, Show a) => Event a
data SomeEvent = forall a. Event a => SomeEvent a
+instance Show SomeEvent where
+ show (SomeEvent a) = show a
fromEvent :: Event a => SomeEvent -> Maybe a
fromEvent (SomeEvent a) = cast a
-data QuitEvent = QuitEvent deriving Typeable
+data QuitEvent = QuitEvent deriving (Typeable, Show)
instance Event QuitEvent
-data ResizeEvent = ResizeEvent Int Int deriving Typeable
+data ResizeEvent = ResizeEvent Int Int deriving (Typeable, Show)
instance Event ResizeEvent
data Key = KeyLeft | KeyRight | KeyUp | KeyDown
deriving (Eq, Ord, Show)
-data KeyPressEvent = KeyPressEvent Key deriving Typeable
+data KeyPressEvent = KeyPressEvent Key deriving (Typeable, Show)
instance Event KeyPressEvent
-data KeyReleaseEvent = KeyReleaseEvent Key deriving Typeable
+data KeyReleaseEvent = KeyReleaseEvent Key deriving (Typeable, Show)
instance Event KeyReleaseEvent
diff --git a/HTanks.hs b/HTanks.hs
index a6ade4f..22b8309 100644
--- a/HTanks.hs
+++ b/HTanks.hs
@@ -10,6 +10,7 @@ import GLX
import Control.Concurrent (threadDelay)
import Control.Monad.State
+import Data.Fixed
import Data.Maybe
import qualified Data.Map as M
import Data.Ratio
@@ -40,7 +41,7 @@ main = do
when (initialized gl) $ do
currentTime <- getCurrentTime
let mainState = MainState {run = True, driver = SomeDriver gl, time = currentTime, keyset = S.empty}
- gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0 0 2], textures = M.empty}
+ gameState = GameState {level = testLevel, tanks = [Tank 0.0 0.0 0 0 2 360 False], textures = M.empty}
runGame gameState $ do
setup 800 600
@@ -70,7 +71,6 @@ mainLoop = do
let d = round $ 1e3*(diffUTCTime currenttime t)
replicateM_ d simulationStep
- --liftIO $ print $ d
let newtime = addUTCTime ((1e-3)*(fromIntegral d)) t
@@ -80,27 +80,70 @@ mainLoop = do
when runnext mainLoop
-simulationStep :: Main ()
-simulationStep = do
+playerMovement :: Main (Maybe Micro, Bool)
+playerMovement = do
keys <- gets keyset
let x = (if (S.member KeyLeft keys) then (-1) else 0) + (if (S.member KeyRight keys) then 1 else 0)
y = (if (S.member KeyDown keys) then (-1) else 0) + (if (S.member KeyUp keys) then 1 else 0)
- let lengthsq = ((x*x)+(y*y))
+ if (x /= 0 || y /= 0)
+ then return (Just $ fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000, True)
+ else return (Nothing, False)
+
+
+simulationStep :: Main ()
+simulationStep = do
+ (angle, move) <- playerMovement
- when (lengthsq /= 0) $ do
- let length = sqrt lengthsq
+ when (isJust angle) $ do
+ tank <- lift $ gets (head . tanks)
+ let oldangle = dir tank
- oldtank <- lift $ gets (head . tanks)
+ let diff = fromJust angle - oldangle
+ let diff360 = if (diff > 180)
+ then (diff-360)
+ else if (diff <= -180)
+ then (diff+360)
+ else diff
- let dx = (speed oldtank) * fromRational (round (x*1000/length)%1000000)
- dy = (speed oldtank) * fromRational (round (y*1000/length)%1000000)
+ let (diff180, angle180) = if (diff360 > 90)
+ then (diff360-180, oldangle+180)
+ else if (diff360 <= -90)
+ then (diff360+180, oldangle-180)
+ else (diff360, oldangle)
- let tank = oldtank {posx = dx + posx oldtank, posy = dy + posy oldtank, dir = fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000}
+ let tspeed = (turnspeed tank)/1000
+ let turn = if (diff180 > tspeed)
+ then tspeed
+ else if (diff180 < -tspeed)
+ then (-tspeed)
+ else diff180
- lift $ modify $ \state -> state {tanks = tank:(tail . tanks $ state)}
-
+ let newangle = angle180 + turn
+
+ let newangle180 = if (newangle > 180)
+ then (newangle-360)
+ else if (newangle <= -180)
+ then (newangle+360)
+ else newangle
+
+ lift $ modify $ \state -> state {tanks = (tank {dir = newangle180}):(tail . tanks $ state)}
+
+ when move $ do
+ tank <- lift $ gets (head . tanks)
+ let moved = moving tank
+
+ when (isNothing angle || (isJust angle && (dir tank == fromJust angle)) || moved) $ do
+ let angle = (fromRational . toRational $ dir tank)*pi/180
+ x = (speed tank) * fromRational (round ((cos angle)*1000)%1000000)
+ y = (speed tank) * fromRational (round ((sin angle)*1000)%1000000)
+
+ lift $ modify $ \state -> state {tanks = (tank {posx = x + posx tank, posy = y + posy tank, moving = True}):(tail . tanks $ state)}
+
+ when (not move) $ do
+ tank <- lift $ gets (head . tanks)
+ lift $ modify $ \state -> state {tanks = (tank {moving = False}):(tail . tanks $ state)}
handleEvents :: Main ()
handleEvents = do
diff --git a/Makefile b/Makefile
index 8de3dc4..f28968b 100644
--- a/Makefile
+++ b/Makefile
@@ -10,4 +10,4 @@ HTanks : $(HSFILES)
hsc2hs $<
clean :
- rm -f HTanks $(HSFILES:%.hs=%.o) $(HSFILES:%.hs=%.hi) $(HSCFILES:%.hsc=%.hs) \ No newline at end of file
+ rm -f HTanks $(HSFILES:%.hs=%.o) $(HSFILES:%.hs=%.hi) $(HSCFILES:%.hsc=%.hs)
diff --git a/Tank.hs b/Tank.hs
index 28f286c..4b68889 100644
--- a/Tank.hs
+++ b/Tank.hs
@@ -9,4 +9,6 @@ data Tank = Tank
, dir :: !Micro
, aim :: !Micro
, speed :: !Micro
+ , turnspeed :: !Micro
+ , moving :: !Bool
} deriving Show
diff --git a/tex/Tank.png b/tex/Tank.png
index 0e60bc1..3e7b6b3 100644
--- a/tex/Tank.png
+++ b/tex/Tank.png
Binary files differ