nek0/tracer
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

bump module Util to affection 0.0.0.10

Browse source
This commit is contained in:
nek0 2020-05-05 06:29:35 +02:00
parent 808ab1db06
commit 8f2366502b
1 changed files with 45 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
src/Util.hs
View file

@ -12,7 +12,9 @@ import Data.Maybe
import qualified Data.Text as T
import Data.String
import Control.Monad (join, when)
import Control.Monad
import Control.Concurrent.MVar
import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL hiding (get)
@ -221,7 +223,8 @@ drawLoadScreen ud (progress, msg) = do
save ctx
fillColor ctx (rgb 255 128 0)
fontSize ctx 100
fontFace ctx (assetFonts ud Map.! FontBedstead)
fonts <- readMVar (assetFonts ud)
fontFace ctx (fonts Map.! FontBedstead)
textAlign ctx (S.fromList [AlignCenter, AlignTop])
textBox ctx 0 300 1280 "Loading"
beginPath ctx
@ -304,17 +307,17 @@ rotVec (V2 x y) deg = V2 nx ny
dtor :: (Num a, Floating a) => a -> a
dtor = (pi / 180 *)
cacheJoypad :: JoystickMessage -> Affection ()
cacheJoypad msg = do
ud <- getAffection
putAffection ud
{ joyCache = msg : joyCache ud
}
cacheJoypad :: UserData -> JoystickMessage -> Affection ()
cacheJoypad ud msg = do
joy <- liftIO $ readMVar (joyCache ud)
void $ liftIO $ swapMVar (joyCache ud) (msg : joy)
emitJoyActionMessage :: JoystickMessage -> Affection ()
emitJoyActionMessage (MsgJoystickAxis time _ axis val) = do
ud <- getAffection
case translation ud of
emitJoyActionMessage :: UserData -> JoystickMessage -> Affection ()
emitJoyActionMessage ud message = do
trans <- liftIO $ readMVar (translation ud)
case message of
MsgJoystickAxis time _ axis val -> do
case trans of
JoyTranslation tmap -> do
let Subsystems _ _ _ _ t = subsystems ud
vnormal = fromIntegral val / 32768
@ -329,23 +332,22 @@ emitJoyActionMessage (MsgJoystickAxis time _ axis val) = do
Just (ActRight _) -> partEmit t (ActionMessage (ActRight sigvnormal) time)
_ -> return ()
_ -> return ()
emitJoyActionMessage (MsgJoystickButton time _ but SDL.JoyButtonPressed) = do
ud <- getAffection
MsgJoystickButton time _ but SDL.JoyButtonPressed -> do
let Subsystems _ _ _ _ t = subsystems ud
case (translation ud) of
case trans of
JoyTranslation tmap -> do
case tmap Map.!? (ButtonAction but SDL.JoyButtonPressed) of
Just act -> partEmit t (ActionMessage act time)
_ -> return ()
_ -> return ()
emitJoyActionMessage _ = return ()
_ -> return ()
emitKbdActionMessage :: KeyboardMessage -> Affection ()
emitKbdActionMessage (MsgKeyboardEvent time _ press False sym) = do
ud <- getAffection
emitKbdActionMessage :: UserData -> KeyboardMessage -> Affection ()
emitKbdActionMessage ud (MsgKeyboardEvent time _ press False sym) = do
let Subsystems _ _ _ _ t = subsystems ud
val = if press == SDL.Pressed then 1 else 0
case (translation ud) of
trans <- liftIO $ readMVar (translation ud)
case trans of
KbdTranslation tmap -> do
case tmap Map.!? SDL.keysymKeycode sym of
Just (ActUp _) -> partEmit t (ActionMessage (ActUp val) time)
@ -355,13 +357,12 @@ emitKbdActionMessage (MsgKeyboardEvent time _ press False sym) = do
Just act -> when (press == SDL.Pressed) (partEmit t (ActionMessage act time))
_ -> return ()
_ -> return ()
emitKbdActionMessage _ = return ()
emitKbdActionMessage _ _ = return ()
fullClean :: Affection ()
fullClean = do
ud <- getAffection
fullClean :: UserData -> Affection ()
fullClean ud = do
let Subsystems w m k j t = subsystems ud
toClean = uuid ud
toClean <- liftIO $ readMVar $ uuid ud
mapM_ (\u -> do
partUnSubscribe w u
partUnSubscribe m u
@ -369,6 +370,4 @@ fullClean = do
partUnSubscribe j u
partUnSubscribe t u
) toClean
putAffection ud
{ uuid = []
}
void $ liftIO $ swapMVar (uuid ud) []