{-# LANGUAGE DeriveDataTypeable, PatternGuards #-} module DefaultPlayer ( DefaultPlayer(..) ) where import qualified Data.Set as S import Data.Fixed import Data.Ratio ((%)) import Data.Typeable import GLDriver import Player import Tank data DefaultPlayer = DefaultPlayer (S.Set Key) Float Float deriving (Typeable, Show) instance Player DefaultPlayer where playerUpdate (DefaultPlayer keys aimx aimy) tank = 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) ax = aimx - (fromRational . toRational $ posx tank) ay = aimy - (fromRational . toRational $ posy tank) move = (x /= 0 || y /= 0) angle = if move then Just $ fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000 else Nothing aangle = if (ax /= 0 || ay /= 0) then Just $ fromRational $ round ((atan2 ay ax)*1000000*180/pi)%1000000 else Nothing in (DefaultPlayer keys aimx aimy, angle, move, aangle) handleEvent (DefaultPlayer keys aimx aimy) ev | Just (KeyPressEvent key) <- fromEvent ev = DefaultPlayer (S.insert key keys) aimx aimy | Just (KeyReleaseEvent key) <- fromEvent ev = DefaultPlayer (S.delete key keys) aimx aimy | Just (MouseMotionEvent x y) <- fromEvent ev = DefaultPlayer keys x y | otherwise = DefaultPlayer keys aimx aimy