eventloop 0.5.0.0 → 0.5.1.0

raw patch · 8 files changed

+163/−2 lines, 8 files

Files

eventloop.cabal +4/−1
src/Eventloop/Module/BasicShapes/Classes.hs +0/−1
src/Eventloop/Module/StatefulGraphics.hs +7/−0
src/Eventloop/Module/StatefulGraphics/StatefulGraphics.hs +123/−0
src/Eventloop/Module/StatefulGraphics/Types.hs +22/−0
src/Eventloop/OutRouter.hs +2/−0
src/Eventloop/Types/Events.hs +2/−0
src/Eventloop/Types/System.hs +3/−0

eventloop.cabal view

@@ -6,7 +6,7 @@ -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.5.0.0
+version:             0.5.1.0
 synopsis:            A different take on an IO system. Based on Amanda's IO loop, this eventloop takes a function that maps input events to output events. It can easily be extended by modules that represent IO devices or join multiple modules together.
 description:         A different take on an IO system. Based on Amanda's IO loop, this eventloop takes a function that maps input events to output events. It can easily be extended by modules that represent IO devices or join multiple modules together.
                      Each module exists of a initialize and teardown function that are both called once at startup and shutting down. During run-time, a module can provice a preprocessor function (which transforms input events before they get to the eventloop),
@@ -40,6 +40,7 @@                        Eventloop.Module.DrawTrees,
                        Eventloop.Module.BasicShapes,
                        Eventloop.Module.File,
+                       Eventloop.Module.StatefulGraphics,
                        Eventloop.Module.StdIn,
                        Eventloop.Module.StdOut, 
                        Eventloop.Module.Timer,
@@ -69,6 +70,8 @@                        Eventloop.Module.BasicShapes.Classes,
                        Eventloop.Module.File.File,
                        Eventloop.Module.File.Types,
+                       Eventloop.Module.StatefulGraphics.StatefulGraphics,
+                       Eventloop.Module.StatefulGraphics.Types,
                        Eventloop.Module.StdIn.StdIn,
                        Eventloop.Module.StdIn.Types,
                        Eventloop.Module.StdOut.StdOut,

src/Eventloop/Module/BasicShapes/Classes.hs view

@@ -145,7 +145,6 @@ Waarom ik een boundingbox met de verkeerde punten op de verkeerde plekken krijg, blijft een raadsel.
 Even kijken of foldBoundingBoxes goed werkt of niet
 
-//TODO NIET VERGETEN JAN TE MAILEN!!!
 -}                                                                                   
 
 findRotationPoint :: (ToCenter a) => a -> Rotation -> Point

+ src/Eventloop/Module/StatefulGraphics.hs view

@@ -0,0 +1,7 @@+module Eventloop.Module.StatefulGraphics+    ( module Eventloop.Module.StatefulGraphics.StatefulGraphics+    , module Eventloop.Module.StatefulGraphics.Types+    ) where++import Eventloop.Module.StatefulGraphics.StatefulGraphics+import Eventloop.Module.StatefulGraphics.Types

+ src/Eventloop/Module/StatefulGraphics/StatefulGraphics.hs view

@@ -0,0 +1,123 @@+module Eventloop.Module.StatefulGraphics.StatefulGraphics+    ( setupStatefulGraphicsModuleConfiguration+    , statefulGraphicsModuleIdentifier+    , statefulGraphicsInitializer+    , statefulGraphicsPostProcessor+    , statefulGraphicsTeardown+    ) where++import Eventloop.Module.StatefulGraphics.Types++import Eventloop.Module.Websocket.Canvas+import Eventloop.Module.BasicShapes+import Eventloop.Types.Common+import Eventloop.Types.Events+import Eventloop.Types.System++import Data.Maybe++import Debug.Trace++setupStatefulGraphicsModuleConfiguration :: EventloopSetupModuleConfiguration+setupStatefulGraphicsModuleConfiguration = ( EventloopSetupModuleConfiguration+                                              statefulGraphicsModuleIdentifier+                                              (Just statefulGraphicsInitializer)+                                              Nothing+                                              Nothing+                                              (Just statefulGraphicsPostProcessor)+                                              Nothing+                                              (Just statefulGraphicsTeardown)+                                          )+++statefulGraphicsModuleIdentifier :: EventloopModuleIdentifier+statefulGraphicsModuleIdentifier = "statefulgraphics"+++statefulGraphicsInitializer :: Initializer+statefulGraphicsInitializer sharedIO+    = return (sharedIO, StatefulGraphicsState [])+++statefulGraphicsTeardown :: Teardown+statefulGraphicsTeardown sharedIO statefulState+    = return (sharedIO)+++statefulGraphicsPostProcessor :: PostProcessor+statefulGraphicsPostProcessor shared (StatefulGraphicsState states) (OutStatefulGraphics canvasId commands)+    = return (shared, StatefulGraphicsState states', newScene)+    where+        (state', newScene) = calculateNewScene canvasId state commands+        stateM = findGraphicalState states canvasId+        state = case stateM of+                    Just state_ -> state_+                    Nothing -> []+        states' = replaceGraphicalState states canvasId state'++statefulGraphicsPostProcessor shared iostate out+    = return (shared, iostate, [out])+++replaceGraphicalState :: GraphicsStates -> CanvasId -> GraphicsState -> GraphicsStates+replaceGraphicalState [] id state = [(id, state)]+replaceGraphicalState ((id, state):states) canvasId newState+    | id == canvasId = (canvasId, newState):states+    | otherwise = (id, state):(replaceGraphicalState states canvasId newState)+++findGraphicalState :: GraphicsStates -> CanvasId -> Maybe GraphicsState+findGraphicalState [] _ = Nothing+findGraphicalState ((id, state):states) canvasId+    | id == canvasId = Just state+    | otherwise =  findGraphicalState states canvasId+++calculateNewScene :: CanvasId -> GraphicsState -> [StatefulGraphicsOut] -> (GraphicsState, [Out])+calculateNewScene canvasId state outs+    = trace "Calculate new scene" (state', [clearCanvas, OutBasicShapes $ DrawShapes canvasId basicShapes])+    where+        (state', performed) = trace ("Outs: " ++ (show $ length outs)) foldl foldPerform (state, []) outs+        foldPerform (state_, performed_) statefulOut = (state_', performed_ ++ [performed_'])+            where+                (state_', performed_') = performStatefulGraphicsOut state_ statefulOut++        clearCanvas = OutCanvas $ CanvasOperations canvasId [Clear ClearCanvas]+        basicShapes = map snd state'+++performStatefulGraphicsOut :: GraphicsState -> StatefulGraphicsOut -> (GraphicsState, GraphicPerformed)+performStatefulGraphicsOut state (Draw statefulGraphic)+    = case oldStatefulGraphicM of+        Just oldStatefulGraphic -> trace ("Modified: " ++ (show $ fst statefulGraphic)) (state', Modified statefulGraphic)+        Nothing                 -> trace ("Drawn: " ++ (show $ fst statefulGraphic)) (state', Drawn statefulGraphic)+    where+        (state', oldStatefulGraphicM) = addOrReplaceGraphics state statefulGraphic+performStatefulGraphicsOut state (Remove id)+    = case oldStatefulGraphicM of+        Just oldStatefulGraphic -> trace ("Removed: " ++ (show id)) (state', Removed oldStatefulGraphic)+        Nothing                 -> trace ("NoOp: " ++ (show id)) (state , NoOp)+    where+        (state', oldStatefulGraphicM) = removeGraphics state id+++addOrReplaceGraphics :: GraphicsState -> StatefulGraphic -> (GraphicsState, (Maybe StatefulGraphic))+addOrReplaceGraphics [] new = ([new], Nothing) -- Add action+addOrReplaceGraphics (old@(id, _):state) new@(id', newGraphic)+    | id == id' = (new:state, Just old) -- Update action+    | otherwise = (old:state', result)+    where+        (state', result) = addOrReplaceGraphics state new+++removeGraphics :: GraphicsState -> NamedId -> (GraphicsState, (Maybe StatefulGraphic))+removeGraphics [] _ = ([], Nothing)+removeGraphics (sg@(id, _):state) id'+    | id == id' = (state, Just sg)+    | otherwise = (sg:state', result)+    where+        (state', result) = removeGraphics state id'++++

+ src/Eventloop/Module/StatefulGraphics/Types.hs view

@@ -0,0 +1,22 @@+module Eventloop.Module.StatefulGraphics.Types where++import Eventloop.Types.Common+import Eventloop.Module.BasicShapes.Types+import Eventloop.Module.Websocket.Canvas.Types++data StatefulGraphicsOut+    = Draw StatefulGraphic+    | Remove NamedId+    deriving (Eq, Show)++data GraphicPerformed+    = Drawn StatefulGraphic+    | Modified StatefulGraphic+    | Removed StatefulGraphic+    | NoOp++type StatefulGraphic = (NamedId, Shape)++type GraphicsState = [StatefulGraphic]+type GraphicsStates = [(CanvasId, GraphicsState)]+

src/Eventloop/OutRouter.hs view

@@ -5,6 +5,7 @@ 
 import Eventloop.Module.File
 import Eventloop.Module.Timer
+import Eventloop.Module.StatefulGraphics
 import Eventloop.Module.StdIn
 import Eventloop.Module.StdOut
 import Eventloop.Module.Websocket.Canvas
@@ -16,4 +17,5 @@                             (OutStdOut _) -> stdOutModuleIdentifier
                             (OutStdIn _) -> stdInModuleIdentifier
                             (OutCanvas _) -> canvasModuleIdentifier
+                            (OutStatefulGraphics _ _) -> statefulGraphicsModuleIdentifier
                             _ -> error ("Could not find route for out event: " ++ show out)

src/Eventloop/Types/Events.hs view

@@ -6,6 +6,7 @@ import Eventloop.Module.DrawTrees.Types
 import Eventloop.Module.BasicShapes.Types
 import Eventloop.Module.File.Types
+import Eventloop.Module.StatefulGraphics.Types
 import Eventloop.Module.StdIn.Types
 import Eventloop.Module.StdOut.Types
 import Eventloop.Module.Timer.Types
@@ -31,5 +32,6 @@          | OutBasicShapes BasicShapesOut
          | OutDrawTrees DrawTreesOut
          | OutGraphs GraphsOut
+         | OutStatefulGraphics CanvasId [StatefulGraphicsOut]
          | Stop
          deriving (Eq, Show)

src/Eventloop/Types/System.hs view

@@ -12,6 +12,7 @@ import Eventloop.Module.Websocket.Mouse.Types
 import Eventloop.Module.Websocket.Canvas.Types
 import Eventloop.Module.File.Types
+import Eventloop.Module.StatefulGraphics.Types
 import Eventloop.Module.StdIn.Types
 import Eventloop.Module.StdOut.Types
 import Eventloop.Module.Timer.Types
@@ -131,4 +132,6 @@              | FileState { newFileInEvents :: [FileIn]
                          , opened          :: [OpenFile]
                          }
+             | StatefulGraphicsState { states :: GraphicsStates
+                                     }
              | NoState