more cleanup

This commit is contained in:
nek0 2018-09-25 16:10:36 +02:00
parent c804a2e013
commit 6bb0076158
18 changed files with 114 additions and 157 deletions

View file

@ -68,10 +68,8 @@ library
, Affection.Logging
, Affection.Types
, Affection.StateMachine
, Affection.MouseInteractable
, Affection.Util
, Affection.MessageBus
, Affection.MessageBus.Util
, Affection.MessageBus.Class
, Affection.MessageBus.Message
, Affection.MessageBus.Message.Class

View file

@ -1,13 +1,14 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
import Affection
import qualified SDL
import Affection as A
import Control.Concurrent.STM
import Control.Monad.IO.Class (liftIO)
import Control.Monad (when)
import qualified SDL hiding (Window(..))
import Data.Maybe (isJust, fromJust)
data StateData = StateData
@ -16,10 +17,10 @@ data StateData = StateData
}
data Subsystems = Subsystems
{ subWindow :: Window
, subMouse :: Mouse
, subKeyboard :: Keyboard
, subJoystick :: Joystick
{ subWindow :: Main.Window
, subMouse :: Main.Mouse
, subKeyboard :: Main.Keyboard
, subJoystick :: Main.Joystick
}
newtype Window = Window (TVar [(UUID, WindowMessage -> Affection StateData ())])
@ -50,8 +51,8 @@ generalUnSubscribe
generalUnSubscribe t uuid =
liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid))
instance Participant Window StateData where
type Mesg Window StateData = WindowMessage
instance Participant Main.Window StateData where
type Mesg Main.Window StateData = WindowMessage
partSubscribers (Window t) = generalSubscribers t
@ -59,7 +60,7 @@ instance Participant Window StateData where
partUnSubscribe (Window t) = generalUnSubscribe t
instance SDLSubsystem Window StateData where
instance SDLSubsystem Main.Window StateData where
consumeSDLEvents = consumeSDLWindowEvents
instance Participant Mouse StateData where
@ -176,7 +177,6 @@ handle es = do
=<< consumeSDLEvents c
=<< consumeSDLEvents d es
mapM_ (\e -> liftIO $ logIO Verbose $ "LEFTOVER: " ++ show e) leftovers
return ()
update _ = return ()

View file

@ -152,89 +152,77 @@ handle es = do
update :: Double -> Affection UserData ()
update _ = do
ud <- getAffection
-- now <- getElapsedTime
when (True) $ do
newList <- mapM (\coord -> do
let x = (coord `mod` 60) + 1
y = (coord `div` 60) + 1
subm
| x == 1 && y == 1 =
(submatrix 60 60 60 60 (lifeMat ud) <|> submatrix 60 60 1 2 (lifeMat ud))
<->
(submatrix 1 2 60 60 (lifeMat ud) <|> submatrix 1 2 1 2 (lifeMat ud))
| x == 1 && y == 60 =
(submatrix 59 60 60 60 (lifeMat ud) <|> submatrix 59 60 1 2 (lifeMat ud))
<->
(submatrix 1 1 60 60 (lifeMat ud) <|> submatrix 1 1 1 2 (lifeMat ud))
| x == 60 && y == 1 =
(submatrix 60 60 59 60 (lifeMat ud) <|> submatrix 60 60 1 1 (lifeMat ud))
<->
(submatrix 1 2 59 60 (lifeMat ud) <|> submatrix 1 2 1 1 (lifeMat ud))
| x == 60 && y == 60 =
(submatrix 59 60 59 60 (lifeMat ud) <|> submatrix 59 60 1 1 (lifeMat ud))
<->
(submatrix 1 1 59 60 (lifeMat ud) <|> submatrix 1 1 1 1 (lifeMat ud))
| x == 1 =
(submatrix (y - 1) (y + 1) 60 60 (lifeMat ud))
<|>
(submatrix (y - 1) (y + 1) 1 2 (lifeMat ud))
| y == 1 =
(submatrix 60 60 (x - 1) (x + 1) (lifeMat ud))
<->
(submatrix 1 2 (x - 1) (x + 1) (lifeMat ud))
| x == 60 =
(submatrix (y - 1) (y + 1) 59 60 (lifeMat ud))
<|>
(submatrix (y - 1) (y + 1) 1 1 (lifeMat ud))
| y == 60 =
(submatrix 59 60 (x -1 ) (x + 1) (lifeMat ud))
<->
(submatrix 1 1 (x - 1) (x + 1) (lifeMat ud))
| otherwise =
submatrix (y - 1) (y + 1) (x - 1) (x + 1) (lifeMat ud)
life = countLife subm
if (lifeMat ud) M.! (y, x) == 1
then if life == 2 || life == 3
then if foodMat ud M.! (y, x) > 0
then return (1, (foodMat ud M.! (y, x)) - 1, 0)
else return (0, foodMat ud M.! (y, x), 1)
else return (0, foodMat ud M.! (y, x), 1)
else if life == 3
then if foodMat ud M.! (y, x) > 0
then return (1, (foodMat ud M.! (y, x)) - 1, 0)
else return
( 0
, if timeMat ud M.! (y, x) > 10
then min 10 ((foodMat ud M.! (y, x)) + 1)
else foodMat ud M.! (y, x)
, timeMat ud M.! (y, x) + 1
)
else return
( 0
, if timeMat ud M.! (y, x) > 10
then min 10 ((foodMat ud M.! (y, x)) + 1)
else foodMat ud M.! (y, x)
, (timeMat ud M.! (y, x)) + 1
)
) [0..3599]
let newLifeMat = fromList 60 60 (map (\(x, _, _) -> x) newList)
let newFoodMat = fromList 60 60 (map (\(_, x, _) -> x) newList)
let newTimeMat = fromList 60 60 (map (\(_, _, x) -> x) newList)
if (newLifeMat == M.zero 60 60)
then
reload
else
putAffection ((newLifeMat, newFoodMat, newTimeMat) `deepseq` ud)
{ lifeMat = newLifeMat
, foodMat = newFoodMat
, timeMat = newTimeMat
-- , lastUpdate = floor now
}
newList <- mapM (\coord -> do
let x = (coord `mod` 60) + 1
y = (coord `div` 60) + 1
subm
| x == 1 && y == 1 =
submatrix 60 60 60 60 (lifeMat ud) <|> submatrix 60 60 1 2 (lifeMat ud)
<->
submatrix 1 2 60 60 (lifeMat ud) <|> submatrix 1 2 1 2 (lifeMat ud)
| x == 1 && y == 60 =
submatrix 59 60 60 60 (lifeMat ud) <|> submatrix 59 60 1 2 (lifeMat ud)
<->
submatrix 1 1 60 60 (lifeMat ud) <|> submatrix 1 1 1 2 (lifeMat ud)
| x == 60 && y == 1 =
submatrix 60 60 59 60 (lifeMat ud) <|> submatrix 60 60 1 1 (lifeMat ud)
<->
submatrix 1 2 59 60 (lifeMat ud) <|> submatrix 1 2 1 1 (lifeMat ud)
| x == 60 && y == 60 =
submatrix 59 60 59 60 (lifeMat ud) <|> submatrix 59 60 1 1 (lifeMat ud)
<->
submatrix 1 1 59 60 (lifeMat ud) <|> submatrix 1 1 1 1 (lifeMat ud)
| x == 1 =
submatrix (y - 1) (y + 1) 60 60 (lifeMat ud)
<|>
submatrix (y - 1) (y + 1) 1 2 (lifeMat ud)
| y == 1 =
submatrix 60 60 (x - 1) (x + 1) (lifeMat ud)
<->
submatrix 1 2 (x - 1) (x + 1) (lifeMat ud)
| x == 60 =
submatrix (y - 1) (y + 1) 59 60 (lifeMat ud)
<|>
submatrix (y - 1) (y + 1) 1 1 (lifeMat ud)
| y == 60 =
submatrix 59 60 (x -1 ) (x + 1) (lifeMat ud)
<->
submatrix 1 1 (x - 1) (x + 1) (lifeMat ud)
| otherwise =
submatrix (y - 1) (y + 1) (x - 1) (x + 1) (lifeMat ud)
life = countLife subm
if lifeMat ud M.! (y, x) == 1
then if life == 2 || life == 3 && foodMat ud M.! (y, x) > 0
then return (1, (foodMat ud M.! (y, x)) - 1, 0)
else return (0, foodMat ud M.! (y, x), 1)
else if life == 3 && foodMat ud M.! (y, x) > 0
then return (1, (foodMat ud M.! (y, x)) - 1, 0)
else return
( 0
, if timeMat ud M.! (y, x) > 10
then min 10 ((foodMat ud M.! (y, x)) + 1)
else foodMat ud M.! (y, x)
, timeMat ud M.! (y, x) + 1
)
) [0..3599]
let newLifeMat = fromList 60 60 (map (\(x, _, _) -> x) newList)
let newFoodMat = fromList 60 60 (map (\(_, x, _) -> x) newList)
let newTimeMat = fromList 60 60 (map (\(_, _, x) -> x) newList)
if newLifeMat == M.zero 60 60
then
reload
else
putAffection ((newLifeMat, newFoodMat, newTimeMat) `deepseq` ud)
{ lifeMat = newLifeMat
, foodMat = newFoodMat
, timeMat = newTimeMat
-- , lastUpdate = floor now
}
countLife :: Matrix Word -> Word
countLife mat = res - (mat M.! (2, 2))
where
res = foldr (\a acc -> acc + a) 0 mat
res = foldr (flip (+)) 0 mat
draw :: Affection UserData ()
draw = do
@ -250,10 +238,10 @@ draw = do
-- logIO A.Debug $ show mult
beginPath ctx
rect ctx (fromIntegral $ x * 10) (fromIntegral $ y * 10) 10 10
if (mult == 1)
then do
if mult == 1
then
fillColor ctx (rgba 255 255 255 255)
else do
else
fillColor ctx (rgba 0 (fromIntegral $ 25 * (foodMat ud M.! (x+1, y+1))) 0 255)
fill ctx
) [0..3599]

View file

@ -22,16 +22,16 @@ data UserData = UserData
}
data Subsystems = Subsystems
{ subWindow :: Window
, subKeyboard :: Keyboard
{ subWindow :: Types.Window
, subKeyboard :: Types.Keyboard
}
newtype Window = Window (TVar [(UUID, WindowMessage -> Affection UserData ())])
newtype Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())])
instance Participant Window UserData where
type Mesg Window UserData = WindowMessage
instance Participant Types.Window UserData where
type Mesg Types.Window UserData = WindowMessage
partSubscribers (Window t) = do
subTups <- liftIO $ readTVarIO t
@ -41,7 +41,7 @@ instance Participant Window UserData where
partUnSubscribe (Window t) = generalUnSubscribe t
instance SDLSubsystem Window UserData where
instance SDLSubsystem Types.Window UserData where
consumeSDLEvents = consumeSDLWindowEvents
instance Participant Keyboard UserData where

View file

@ -21,11 +21,8 @@ import Control.Monad.IO.Class (liftIO)
import Foreign.C.Types (CInt(..))
import Debug.Trace
import Affection.Types as A
import Affection.StateMachine as A
import Affection.MouseInteractable as A
import Affection.Util as A
import Affection.MessageBus as A
import Affection.Subsystems as A
@ -88,10 +85,7 @@ withAffection AffectionConfig{..} = do
(_, nState) <- runStateT ( A.runState $ do
liftIO $ logIO Debug "Starting Loop"
preLoop
whileM_ (do
current <- get
return $ not $ A.quitEvent current
)
whileM_ (not . A.quitEvent current <$> get)
(do
-- get state
ad <- get

View file

@ -1,7 +1,7 @@
{-# LANGUAGE CPP #-}
module Affection.Logging where
-- ^ This module defines the logging capability of Affection, whis is derived
-- | This module defines the logging capability of Affection, whis is derived
-- from "Debug.Trace".
module Affection.Logging where
import Debug.Trace

View file

@ -5,6 +5,5 @@ module Affection.MessageBus
import Affection.MessageBus.Class as M
import Affection.MessageBus.Message as M
import Affection.MessageBus.Util as M
import Affection.MessageBus.Message as Msg

View file

@ -3,7 +3,11 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ExistentialQuantification #-}
module Affection.MessageBus.Class where
module Affection.MessageBus.Class
( Participant(..)
, genUUID
, UUID
) where
import Affection.MessageBus.Message
import Affection.Types

View file

@ -7,21 +7,21 @@ module Affection.MessageBus.Message.JoystickMessage
, SDL.JoyButtonState
, SDL.JoyDeviceConnection
-- | Number exports
, Word8(..)
, Int16(..)
, Int32(..)
, Word8
, Int16
, Int32
) where
import Affection.MessageBus.Message.Class
import Data.Word (Word8(..))
import Data.Int (Int32(..), Int16(..))
import Data.Word (Word8)
import Data.Int (Int32, Int16)
import qualified SDL
import Linear (V2(..))
-- Datatype for handling all possible joystick events handed over from sdl2
-- | Datatype for handling all possible joystick events handed over from sdl2
data JoystickMessage
= MsgJoystickAxis -- ^ Movement of a Joystick axis
{ msgJAWhen :: Double -- ^ Time of event

View file

@ -10,8 +10,8 @@ module Affection.MessageBus.Message.MouseMessage
import Affection.MessageBus.Message.Class
import Data.Word (Word8(..))
import Data.Int (Int32(..))
import Data.Word (Word8)
import Data.Int (Int32)
import qualified SDL

View file

@ -6,7 +6,7 @@ module Affection.MessageBus.Message.WindowMessage
import Affection.MessageBus.Message.Class
import Data.Int (Int32(..))
import Data.Int (Int32)
import qualified SDL

View file

@ -5,14 +5,12 @@
module Affection.Subsystems.AffectionJoystick where
import Affection.MessageBus
import Affection.Subsystems.Class
import Affection.Types
import Affection.Util
import Affection.Logging
import Control.Monad (filterM)
import Control.Monad.IO.Class (liftIO)
import Control.Concurrent.STM
import qualified Data.Vector as V
@ -86,8 +84,8 @@ joystickAutoConnect
-- ^ Returns a joystick descriptor, if successful
joystickAutoConnect (MsgJoystickDevice _ which SDL.JoyDeviceAdded) = liftIO $ do
[descr] <- V.toList <$>
(return . V.filter (\(SDL.JoystickDevice _ id) -> id == CInt which)
=<< SDL.availableJoysticks)
(V.filter (\(SDL.JoystickDevice _ i) -> i == CInt which) <$>
SDL.availableJoysticks)
logIO Verbose $ "Connecting Joystick " ++ show which ++ " " ++ show descr
Just <$> SDL.openJoystick descr
joystickAutoConnect _ = return Nothing
@ -103,7 +101,7 @@ joystickAutoDisconnect js (MsgJoystickDevice _ which SDL.JoyDeviceRemoved) =
liftIO $ do
joyIds <- mapM SDL.getJoystickID js
logIO Verbose $ "These are the Joysticks connected: " ++ show joyIds
[d] <- filterM (\j -> return . (which ==) =<< SDL.getJoystickID j) js
[d] <- filterM ((which ==) <$> SDL.getJoystickID) js
logIO Verbose $ "disconnected joysticks: " ++ show d
logIO Verbose $ "Disconnecting Joystick " ++ show which
SDL.closeJoystick d

View file

@ -7,10 +7,6 @@ module Affection.Subsystems.AffectionKeyboard where
import Affection.Types
import Affection.Util
import Affection.MessageBus
import Affection.Subsystems.Class
import Control.Concurrent.STM as STM
import Control.Monad.IO.Class (liftIO)
import qualified SDL

View file

@ -5,13 +5,9 @@
module Affection.Subsystems.AffectionMouse where
import Affection.MessageBus
import Affection.Subsystems.Class
import Affection.Types
import Affection.Util
import Control.Monad.IO.Class (liftIO)
import Control.Concurrent.STM
import Linear.Affine (unP)
import qualified SDL

View file

@ -9,10 +9,6 @@ module Affection.Subsystems.AffectionWindow where
import Affection.Types
import Affection.Util
import Affection.MessageBus
import Affection.Subsystems.Class
import Control.Concurrent.STM as STM
import Control.Monad.IO.Class (liftIO)
import qualified SDL

View file

@ -3,7 +3,6 @@
module Affection.Subsystems.Class where
import Affection.Types
import Affection.MessageBus
import qualified SDL

View file

@ -1,26 +1,25 @@
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
module Affection.Types
( Affection(..)
( Affection
, AffectionConfig(..)
, AffectionData(..)
, AffectionStateInner(..)
, AffectionStateInner
, AffectionState(..)
, InitComponents(..)
, Angle(..)
, Angle
-- | SDL reexports
, SDL.WindowConfig(..)
, SDL.WindowMode(..)
, SDL.EventPayload(..)
, SDL.InitFlags(..)
, SDL.Window(..)
, SDL.GLContext(..)
, SDL.InitFlag(..)
, SDL.Window
, SDL.GLContext
) where
import qualified SDL.Init as SDL
import qualified SDL.Video as SDL
import qualified SDL.Event as SDL
import qualified Data.Text as T
import Data.Map.Strict as M
import Control.Monad.IO.Class
import Control.Monad.State.Strict
@ -28,10 +27,6 @@ import qualified Control.Monad.Parallel as MP
import System.Clock (TimeSpec)
import Foreign.Ptr (Ptr)
import Affection.MessageBus.Message
-- | Configuration for the aplication. needed at startup.
data AffectionConfig us = AffectionConfig
{ initComponents :: InitComponents
@ -71,8 +66,6 @@ data AffectionData us = AffectionData
, glContext :: SDL.GLContext -- ^ OpenGL rendering context
, screenMode :: SDL.WindowMode -- ^ current screen mode
, drawDimensions :: (Int, Int) -- ^ Dimensions of target surface
, drawStride :: Int -- ^ Stride of target buffer
, drawCPP :: Int -- ^ Number of components per pixel
, elapsedTime :: Double -- ^ Elapsed time in seconds
, deltaTime :: Double -- ^ Elapsed time in seconds since last tick
, sysTime :: TimeSpec -- ^ System time (NOT the time on the clock)

View file

@ -19,9 +19,7 @@ preHandleEvents evs =
-- | Return the userstate to the user
getAffection :: Affection us us
getAffection = do
ad <- get
return $ userState ad
getAffection = gets userState
-- | Put altered user state back
putAffection
@ -40,12 +38,10 @@ delaySec dur = SDL.delay (fromIntegral $ dur * 1000)
-- | Get time since start but always the same in the current tick.
getElapsedTime :: Affection us Double
getElapsedTime =
elapsedTime <$> get
getElapsedTime = gets elapsedTime
getDelta :: Affection us Double
getDelta =
deltaTime <$> get
getDelta = gets deltaTime
quit :: Affection us ()
quit = do