eventloop 0.3.0.0 → 0.4.0.0

raw patch · 23 files changed

+686/−200 lines, 23 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• eventloop.cabal +7/−4
• src/Eventloop/EventloopCore.hs +10/−5
• src/Eventloop/Module/BasicShapes.hs +3/−1
• src/Eventloop/Module/BasicShapes/Classes.hs +142/−66
• src/Eventloop/Module/BasicShapes/Types.hs +21/−9
• src/Eventloop/Module/DrawTrees/DrawTrees.hs +24/−20
• src/Eventloop/Module/DrawTrees/Types.hs +1/−5
• src/Eventloop/Module/Graphs.hs +7/−0
• src/Eventloop/Module/Graphs/Graphs.hs +238/−0
• src/Eventloop/Module/Graphs/Types.hs +58/−0
• src/Eventloop/Module/Websocket/Canvas/Canvas.hs +1/−0
• src/Eventloop/Module/Websocket/Canvas/JSONEncoding.hs +31/−15
• src/Eventloop/Module/Websocket/Canvas/Opcode.hs +20/−9
• src/Eventloop/Module/Websocket/Canvas/Types.hs +28/−12
• src/Eventloop/Module/Websocket/Keyboard/Keyboard.hs +1/−0
• src/Eventloop/Module/Websocket/Mouse/Mouse.hs +44/−27
• src/Eventloop/Module/Websocket/Mouse/Types.hs +15/−9
• src/Eventloop/Types/EventTypes.hs +6/−3
• src/Eventloop/Utility/BufferedWebsockets.hs +2/−2
• src/Eventloop/Utility/Trees/GeneralTree.hs +1/−1
• src/Eventloop/Utility/Trees/LayoutTree.hs +5/−4
• src/Eventloop/Utility/Vectors.hs +4/−1
• src/Eventloop/Utility/Websockets.hs +17/−7

@@ -6,7 +6,7 @@ -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.3.0.0
+version:             0.4.0.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),
@@ -35,6 +35,7 @@                        Eventloop.Types.EventTypes,
                        Eventloop.Types.Common,
                        Eventloop.Utility.Vectors,
+                       Eventloop.Utility.Trees.GeneralTree,
                        Eventloop.RouteEvent,
                        Eventloop.DefaultConfiguration,
                        Eventloop.Module.Websocket.Canvas, 
@@ -45,14 +46,14 @@                        Eventloop.Module.File,
                        Eventloop.Module.StdIn,
                        Eventloop.Module.StdOut, 
-                       Eventloop.Module.Timer
+                       Eventloop.Module.Timer,
+                       Eventloop.Module.Graphs
 
   -- Modules included in this library but not exported.
   other-modules:       Eventloop.Utility.Websockets,
                        Eventloop.Utility.BufferedWebsockets,
                        Eventloop.Utility.Config,
                        Eventloop.Utility.Trees.LayoutTree,
-                       Eventloop.Utility.Trees.GeneralTree,
                        Eventloop.Module.Websocket.Canvas.Canvas,
                        Eventloop.Module.Websocket.Canvas.JSONEncoding,
                        Eventloop.Module.Websocket.Canvas.Opcode,
@@ -73,7 +74,9 @@                        Eventloop.Module.StdOut.StdOut,
                        Eventloop.Module.StdOut.Types,
                        Eventloop.Module.Timer.Timer,
-                       Eventloop.Module.Timer.Types
+                       Eventloop.Module.Timer.Types,
+                       Eventloop.Module.Graphs.Graphs,
+                       Eventloop.Module.Graphs.Types
   
   other-extensions:    OverloadedStrings
   

@@ -5,6 +5,7 @@ import Eventloop.Types.EventTypes
 
 import Data.Maybe
+import Control.Exception
 
                                                                                         
 startMainloop :: EventloopConfiguration progstateT -> IO ()
@@ -12,12 +13,16 @@                                                       , sharedIOState = sharedIO
                                                       }) = do
                                                                (sharedIO', moduleConfigs') <- withIOStateModules sharedIO initializer moduleConfigs
-                                                               eventloopConfig'' <- startMainloopWithStart (eventloopConfig {moduleConfigurations=moduleConfigs', sharedIOState=sharedIO'})
                                                                let
-                                                                moduleConfigs'' = moduleConfigurations eventloopConfig''
-                                                                sharedIO''      = sharedIOState eventloopConfig''
-                                                               (sharedIO''', moduleStates''') <- withIOStateModules sharedIO'' teardown moduleConfigs''
-                                                               return ()
+                                                                eventloopConfig' = eventloopConfig {moduleConfigurations=moduleConfigs', sharedIOState=sharedIO'}
+                                                                emergencyTeardown = withIOStateModules sharedIO' teardown moduleConfigs'
+                                                               (flip onException) emergencyTeardown $ do
+                                                                                                           eventloopConfig'' <- startMainloopWithStart eventloopConfig'
+                                                                                                           let
+                                                                                                            moduleConfigs'' = moduleConfigurations eventloopConfig''
+                                                                                                            sharedIO''      = sharedIOState eventloopConfig''
+                                                                                                           (sharedIO''', moduleStates''') <- withIOStateModules sharedIO'' teardown moduleConfigs''
+                                                                                                           return ()
 
 withIOStateModules :: SharedIOState -> 
                       (EventloopModuleConfiguration -> Maybe (SharedIOState -> IOState -> IO (SharedIOState, IOState))) ->

@@ -1,7 +1,9 @@ module Eventloop.Module.BasicShapes
     ( module Eventloop.Module.BasicShapes.BasicShapes
     , module Eventloop.Module.BasicShapes.Types
+    , module Eventloop.Module.BasicShapes.Classes
     ) where
     
 import Eventloop.Module.BasicShapes.BasicShapes
-import Eventloop.Module.BasicShapes.Types+import Eventloop.Module.BasicShapes.Types
+import Eventloop.Module.BasicShapes.Classes

@@ -4,9 +4,10 @@ import Eventloop.Module.BasicShapes.Types
 import qualified Eventloop.Module.Websocket.Canvas.Types as CT
 
+import Debug.Trace
 
 addBoundingBox :: BoundingBox -> BoundingBox -> BoundingBox
-addBoundingBox (BoundingBox p11 p21 p31 p41) (BoundingBox p12 p22 p32 p42) = BoundingBox (Point (xMin, yMin)) (Point (xMax, yMin)) (Point (xMax, yMax)) (Point (xMin, yMax))
+addBoundingBox (BoundingBox p11 p21 p31 p41) (BoundingBox p12 p22 p32 p42) = BoundingBox (Point (xMin, yMin)) (Point (xMin, yMax)) (Point (xMax, yMax)) (Point (xMax, yMin))
                                                         where
                                                             allPoints = [p11, p21, p31, p41, p12, p22, p32, p42]
                                                             xs = map (\(Point (x,y)) -> x) allPoints
@@ -21,9 +22,6 @@ foldBoundingBoxes op (box:bs) = foldl op box bs
               
 
-translateBoundingBox :: Translation -> BoundingBox -> BoundingBox
-translateBoundingBox pTrans = opOnBoundingBox ((|+|) pTrans)
-
 opOnBoundingBox :: (Point -> Point) -> BoundingBox -> BoundingBox
 opOnBoundingBox op (BoundingBox p1 p2 p3 p4) = BoundingBox (op p1)
                                                            (op p2)
@@ -45,12 +43,26 @@ roundPoint (Point (x, y)) = (round x, round y)
 
 
-roundShapeColor :: ShapeColor -> (CT.ScreenColor, CT.ScreenColor)
-roundShapeColor (strokeColor, fillColor) = (roundColor strokeColor, roundColor fillColor)
-
 roundColor :: Color -> CT.ScreenColor
 roundColor (r, b, g, a) = (round r, round b, round g, a)
-                                    
+
+instance Translate BoundingBox where
+    translate pTrans = opOnBoundingBox ((|+|) pTrans)
+
+instance Translate Shape where
+    translate p b@(BaseShape {primitive=prim})          = b {primitive = translate p prim}
+    translate p (CompositeShape shapes Nothing rotM)    = CompositeShape shapes (Just p) rotM
+    translate p2 (CompositeShape shapes (Just p1) rotM) = CompositeShape shapes (Just $ p1 |+| p2) rotM
+    
+instance Translate Primitive where
+    translate p r@(Rectangle {translation=trans}) = r {translation = trans |+| p}
+    translate p c@(Circle {translation=trans})    = c {translation = trans |+| p}
+    translate p po@(Polygon {translation=trans})  = po {translation = trans |+| p}
+    translate p t@(Text {translation=trans})      = t {translation = trans |+| p}
+    translate pTrans (Line p1 p2)                 = Line (p1 |+| pTrans) (p2 |+| pTrans)
+    translate pTrans (MultiLine p1 p2 ops)        = MultiLine (p1 |+| pTrans) (p2 |+| pTrans) (map ((|+|) pTrans) ops)
+      
+      
 instance RotateLeftAround BoundingBox where               
     rotateLeftAround rotatePoint aDeg box = opOnBoundingBox (rotateLeftAround rotatePoint aDeg) box
     
@@ -67,8 +79,8 @@ instance ToCenter BoundingBox where
     toCenter (BoundingBox (Point (x1, y1)) (Point (x2, y2)) _ (Point (x4, y4))) = Point (x1 + 0.5 * w, y1 + 0.5 * h)
                                                             where
-                                                                w = x2 - x1
-                                                                h = y4 - x1
+                                                                w = x4 - x1
+                                                                h = y2 - y1
     
     
 class ToBoundingBox a where
@@ -78,12 +90,12 @@     toBoundingBox box = box
     
 instance ToBoundingBox Primitive where
-    toBoundingBox (Rectangle (Point (x, y)) (w, h)) = BoundingBox (Point (x, y)) (Point (x + w, y)) (Point (x + w, y + h)) (Point (x, y + h))
-    toBoundingBox (Circle p r) = toBoundingBox (Rectangle p (r, r))
-    toBoundingBox (Polygon _ p r) = toBoundingBox (Circle p r)
-    toBoundingBox (Text _ _ _ p) = BoundingBox p p p p
-    toBoundingBox (Line p1 p2) = BoundingBox p1 p2 p2 p1 
-    toBoundingBox (MultiLine p1 p2 ops) = BoundingBox (Point (xMin, yMin)) (Point (xMax, yMin)) (Point (xMax, yMax)) (Point (xMin, yMax))
+    toBoundingBox (Rectangle (Point (x, y)) (w, h) _) = BoundingBox (Point (x, y)) (Point (x, y + h)) (Point (x + w, y + h)) (Point (x + w, y))
+    toBoundingBox (Circle p r f) = trace ((++) "Circle P:" $ show (p |-| (Point (r, r)))) toBoundingBox (Rectangle (p |-| (Point (r, r))) (2 * r, 2 * r) f)
+    toBoundingBox (Polygon _ p r f) = toBoundingBox (Circle p r f)
+    toBoundingBox (Text _ _ _ p _) = BoundingBox p p p p
+    toBoundingBox (Line p1 p2) = toBoundingBox (MultiLine p1 p2 []) 
+    toBoundingBox (MultiLine p1 p2 ops) = BoundingBox (Point (xMin, yMin)) (Point (xMin, yMax)) (Point (xMax, yMax)) (Point (xMax, yMin))
                                         where
                                             points = p1:p2:ops
                                             xs = map (\(Point (x, y)) -> x) points
@@ -94,20 +106,20 @@                                             yMax = maximum ys
                                         
 instance ToBoundingBox Shape where
-    toBoundingBox (BaseShape prim _ (Just rotation)) = rotatedBox
-                                                    where
-                                                        baseBox = toBoundingBox prim
-                                                        rotationPoint = findRotationPoint prim rotation
-                                                        (Rotation _ angle) = rotation
-                                                        rotatedBox = rotateLeftAround rotationPoint angle baseBox
-    toBoundingBox (BaseShape prim _ Nothing) = toBoundingBox prim
+    toBoundingBox (BaseShape prim _ _ (Just rotation)) = rotatedBox
+                                                       where
+                                                           baseBox = toBoundingBox prim
+                                                           rotationPoint = findRotationPoint prim rotation
+                                                           (Rotation _ angle) = rotation
+                                                           rotatedBox = rotateLeftAround rotationPoint angle baseBox
+    toBoundingBox (BaseShape prim _ _ Nothing) = toBoundingBox prim
     toBoundingBox (CompositeShape shapes (Just translation) (Just rotation)) = rotateLeftAround rotationPoint angle translatedBox
                                                                             where
                                                                                baseBox = toBoundingBox (CompositeShape shapes Nothing Nothing)
-                                                                               translatedBox = translateBoundingBox translation baseBox
+                                                                               translatedBox = translate translation baseBox
                                                                                rotationPoint = findRotationPoint translatedBox rotation
                                                                                (Rotation _ angle) = rotation
-    toBoundingBox (CompositeShape shapes (Just translation) Nothing) = translateBoundingBox translation baseBox
+    toBoundingBox (CompositeShape shapes (Just translation) Nothing) = translate translation baseBox
                                                                     where
                                                                         baseBox = toBoundingBox (CompositeShape shapes Nothing Nothing)
     toBoundingBox (CompositeShape shapes Nothing (Just rotation)) = rotateLeftAround rotationPoint angle baseBox
@@ -117,8 +129,25 @@                                                                     (Rotation _ angle) = rotation
     toBoundingBox (CompositeShape shapes Nothing Nothing) = foldBoundingBoxes addBoundingBox $ map toBoundingBox shapes
 
-                                                                                   
+{-
+Er is een probleem met waar de rotationpoint staat.
+De boundingbox van CompositeShapes ziet er vreemd uit.
+Het probleem kan zijn omdat er ergens nog de oude manier van boundingboxes staat, maar waar?
+Als de boundingbox weer correct is, wordt het rotationpoint ook weer correct.
 
+Daarnaast moet er nog even nagedacht worden over de translatie en rotatiepunt van op elkaar gestapelde
+composite shapes. Wordt de boundingbox lokaal uitgerekend? Wordt het rotatiepunt lokaal uitgerekent?
+Meerdere translaties op elkaar in canvas, kan dat of is de translatie steeds vanuit het oude origin?
+
+Fix 1: De boundingboxes van shapes in compositeshape samen voegen zonder de translatie van die compositeshape.
+Daarmee krijg je de locale boundingbox met de correcte center punt.
+
+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
 findRotationPoint a (Rotation AroundCenter _) = toCenter a
 findRotationPoint _ (Rotation (AroundPoint p) _) = p
@@ -137,67 +166,114 @@     toCanvasOperations :: a -> [CT.CanvasOperation]  
 
 instance ToCanvasOperations Shape where
-    toCanvasOperations (BaseShape prim color (Just rotation)) 
-        | angle == 0 = drawOperations
+    toCanvasOperations (BaseShape prim lineThick color (Just rotation)) 
+        | angle == 0 = toCanvasOperations (BaseShape prim lineThick color Nothing)
         | otherwise = [ CT.DoTransform CT.Save
                       , CT.DoTransform (CT.Translate screenRotationPoint)
                       , CT.DoTransform (CT.Rotate screenAngle)
-                      ] ++ drawOperations ++
+                      ] ++ movedDrawOperations ++
                       [ CT.DoTransform CT.Restore
                       ]
         where
-            screenRotationPoint = roundPoint $ findRotationPoint prim rotation
-            drawOperations = toCanvasOperations (BaseShape prim color Nothing)
+            rotationPoint = findRotationPoint prim rotation
+            screenRotationPoint = roundPoint rotationPoint
+            movedPrim = translate (negateVector rotationPoint) prim 
+            movedDrawOperations = toCanvasOperations (BaseShape movedPrim lineThick color Nothing)
             (Rotation _ angle) = rotation
             screenAngle = round angle
             
     -- Rotation is broken. When we translated to rotationpoint, translation of prim should be adjusted accordingly (prim' = move prim (-rotationPoint))
-    -- Multiline gets filled even though we do moveto finally. Solution: Move ShapeColor to primitives and skip fill for both Line and MultiLine
-    -- Rectangle might be broken. Not sure though. The translation point might be, visually, bottom right instead of bottom right in the coordinate system.
                                                                 
-    toCanvasOperations (BaseShape (Text text fontF fontS p) color Nothing)  = [CT.DrawText canvasText p' textRender]
-                                                                            where
-                                                                                canvasText = CT.CanvasText text (CT.Font fontF $ round fontS) CT.AlignCenter
-                                                                                textRender = CT.TextFill (CT.CanvasColor screenFillColor)
-                                                                                (screenStrokeColor, screenFillColor) = roundShapeColor color
-                                                                                p' = roundPoint p
+    toCanvasOperations (BaseShape (Text text fontF fontS p fillColor) lineThick strokeColor Nothing)  = [CT.DrawText canvasText p' textStroke textFill]
+                                                                                                      where
+                                                                                                          canvasText = CT.CanvasText text (CT.Font fontF $ round fontS) CT.AlignCenter
+                                                                                                          textFill = CT.TextFill (CT.CanvasColor screenFillColor)
+                                                                                                          textStroke = CT.TextStroke (round lineThick) (CT.CanvasColor screenStrokeColor)
+                                                                                                          screenStrokeColor = roundColor strokeColor
+                                                                                                          screenFillColor = roundColor fillColor
+                                                                                                          p' = roundPoint p
 
-    toCanvasOperations (BaseShape prim color Nothing) = [CT.DrawPath startingPoint screenPathParts pathStroke pathFill]
-                                                    where
-                                                        (screenPathParts, startingPoint) = toScreenPathParts prim
-                                                        pathStroke = CT.PathStroke (CT.CanvasColor screenStrokeColor)
-                                                        pathFill = CT.PathFill (CT.CanvasColor screenFillColor)
-                                                        (screenStrokeColor, screenFillColor) = roundShapeColor color
+    toCanvasOperations (BaseShape prim lineThick strokeColor Nothing) = case fillColorM of
+                                                                            (Just fillColor') -> [CT.DrawPath startingPoint screenPathParts pathStroke pathFill]
+                                                                                              where
+                                                                                                  screenFillColor = roundColor fillColor'
+                                                                                                  pathFill = CT.PathFill (CT.CanvasColor screenFillColor)
+                                                                            Nothing           -> [CT.DrawPath startingPoint screenPathParts pathStroke CT.NoPathFill]
+                                                                      where
+                                                                          (screenPathParts, startingPoint, fillColorM) = toScreenPathParts prim
+                                                                          pathStroke = CT.PathStroke (round lineThick) (CT.CanvasColor screenStrokeColor)
+                                                                          screenStrokeColor = roundColor strokeColor
 
-    toCanvasOperations (CompositeShape shapes Nothing Nothing) = concat canvasOperationsList
-                                                            where
-                                                                canvasOperationsList = map toCanvasOperations shapes
-                                                        
+    toCanvasOperations (CompositeShape shapes Nothing Nothing) = (concat.(map toCanvasOperations)) shapes
+
+    toCanvasOperations c@(CompositeShape shapes (Just translation) (Just rotation))
+        | angle == 0 = toCanvasOperations (CompositeShape shapes (Just translation) Nothing)
+        | otherwise  = trace (show $ rotationPoint) $ trace (show $ toBoundingBox c) $ trace (show movedDrawOperations) [ CT.DoTransform CT.Save
+                       , CT.DoTransform (CT.Translate screenTotalTranslation)
+                       , CT.DoTransform (CT.Rotate screenAngle)
+                       ] ++ movedDrawOperations ++
+                       [ CT.DoTransform CT.Restore
+                       ]
+        where
+            rotationPoint = findRotationPoint c rotation
+            movedShapes = map (translate (negateVector rotationPoint)) shapes
+            movedDrawOperations = toCanvasOperations (CompositeShape movedShapes Nothing Nothing)
+            (Rotation _ angle) = rotation
+            screenAngle = round angle
+            screenTotalTranslation = roundPoint (translation |+| rotationPoint)
+            
+    toCanvasOperations c@(CompositeShape shapes Nothing (Just rotation))
+        | angle == 0 = toCanvasOperations (CompositeShape shapes Nothing Nothing)
+        | otherwise  = [ CT.DoTransform CT.Save
+                       , CT.DoTransform (CT.Translate screenRotationPoint)
+                       , CT.DoTransform (CT.Rotate screenAngle)
+                       ] ++ movedDrawOperations ++
+                       [ CT.DoTransform CT.Restore
+                       ]
+        where
+            rotationPoint = findRotationPoint c rotation
+            movedShapes = map (translate (negateVector rotationPoint)) shapes
+            movedDrawOperations = toCanvasOperations (CompositeShape movedShapes Nothing Nothing)
+            (Rotation _ angle) = rotation
+            screenAngle = round angle
+            screenRotationPoint = roundPoint rotationPoint
+            
+    toCanvasOperations (CompositeShape shapes (Just translate) Nothing)
+        = [ CT.DoTransform CT.Save
+          , CT.DoTransform (CT.Translate screenTranslationPoint)
+          ] ++ drawOperations ++
+          [ CT.DoTransform CT.Restore
+          ]
+        where
+            screenTranslationPoint = roundPoint translate
+            drawOperations = toCanvasOperations (CompositeShape shapes Nothing Nothing)
+          
+          
 class ToScreenPathPart a where
-    toScreenPathParts :: a -> ([CT.ScreenPathPart], CT.ScreenStartingPoint)    
+    toScreenPathParts :: a -> ([CT.ScreenPathPart], CT.ScreenStartingPoint, Maybe FillColor)    
     
 instance ToScreenPathPart Primitive where
-    toScreenPathParts (Rectangle p (w, h)) = ([CT.Rectangle p' (w', h')], p')
-                                                        where
-                                                            p' = roundPoint p
-                                                            w' = round w
-                                                            h' = round h
-    toScreenPathParts (Circle p r) = ([CT.Arc (p', r') 0 360], p')
-                                                where
-                                                    p' = roundPoint p
-                                                    r' = round r
-    toScreenPathParts (Polygon n p r) = (lines, screenPoint)
-                                    where
-                                        polygonPoints = allPolygonPoints n p r
-                                        (screenPoint:ps) = map roundPoint polygonPoints
-                                        lines = [CT.LineTo screenPoint' | screenPoint' <- (ps ++ [screenPoint])]
+    toScreenPathParts (Rectangle p (w, h) f) = ([CT.Rectangle p' (w', h')], p', Just f)
+                                             where
+                                                 p' = roundPoint p
+                                                 w' = round w
+                                                 h' = round h
+    toScreenPathParts (Circle p r f) = ([CT.Arc (p', r') 0 360], p', Just f)
+                                     where
+                                         p' = roundPoint p
+                                         r' = round r
+    toScreenPathParts (Polygon n p r f) = (lines, screenPoint, Just f)
+                                        where
+                                            polygonPoints = allPolygonPoints n p r
+                                            (screenPoint:ps) = map roundPoint polygonPoints
+                                            lines = [CT.LineTo screenPoint' | screenPoint' <- (ps ++ [screenPoint])]
     toScreenPathParts (Text {}) = error "Text is stupid and not implemented the same way in JS canvas"
-    toScreenPathParts (Line p1 p2) = ([CT.LineTo p2'], p1')
+    toScreenPathParts (Line p1 p2) = ([CT.LineTo p2'], p1', Nothing)
                                     where
                                         p1' = roundPoint p1
                                         p2' = roundPoint p2
                                         
-    toScreenPathParts (MultiLine p1 p2 otherPoints) = (lines ++ [CT.MoveTo p1'], p1')
+    toScreenPathParts (MultiLine p1 p2 otherPoints) = (lines ++ [CT.MoveTo p1'], p1', Nothing)
                                                     where
                                                         allPoints = p1:p2:otherPoints
                                                         (p1':otherPoints') = map roundPoint allPoints

@@ -22,8 +22,9 @@ type Color = (Red, Green, Blue, Alpha)
 type FillColor = Color
 type StrokeColor = Color
-type ShapeColor = (StrokeColor, FillColor)
 
+type StrokeLineThickness = GraphicalNumeric
+
 type UpperLeft = Point
 type UpperRight = Point
 type LowerLeft = Point
@@ -38,24 +39,35 @@ data BasicShapesOut = DrawShapes CT.CanvasId [Shape]
                     deriving (Show, Eq)
 
-data Shape = BaseShape Primitive ShapeColor (Maybe Rotation)
-           | CompositeShape [Shape] (Maybe Translation) (Maybe Rotation) -- ^Should contain atleast 1 shape
+data Shape = BaseShape { primitive :: Primitive
+                       , strokeLineThickness :: StrokeLineThickness
+                       , strokeColor :: StrokeColor
+                       , rotationM :: (Maybe Rotation)
+                       }
+           | CompositeShape { shapes :: [Shape]
+                            , translationM :: (Maybe Translation)
+                            , rotationM :: (Maybe Rotation)
+                            } -- ^Should contain atleast 1 shape
            deriving (Show, Eq)
            
-data Primitive = Rectangle { translation :: Translation 
+data Primitive = Rectangle { translation :: Translation -- ^| Translation is the corner closes to origin. Visually in canvas, this is top left. In a Cartesian coördinate system, this is bottom left.
                            , dimensions :: Dimensions
+                           , fillColor :: FillColor
                            } -- ^Translation is upperleftcorner
-               | Circle { translation :: Translation 
+               | Circle { translation :: Translation -- ^| Translation is the centre of the circle
                         , radius :: Radius
+                        , fillColor :: FillColor
                         } -- ^Translation is center
                | Polygon { amountOfPoints :: AmountOfPoints
-                         , translation :: Translation
+                         , translation :: Translation -- ^| Translation is the the centre of the polygon
                          , radius :: Radius
-                         } -- ^Translation is center
+                         , fillColor :: FillColor
+                         } -- ^The first point of the polygon, always starts in the direction from the x-axis.(Towards x-infinity)
                | Text { text :: [Char] 
                       , fontFamily :: FontFamily
                       , fontSize :: FontSize
                       , translation :: Translation
+                      , fillColor :: FillColor
                       } -- ^Translation is center, does not have a boundingbox due to technical limitations
                | Line { point1 :: Point
                       , point2 :: Point 
@@ -67,14 +79,14 @@                deriving (Show, Eq)
            
            
-data Rotation = Rotation RotatePoint Angle
+data Rotation = Rotation RotatePoint Angle -- ^| Rotation is around a point on the canvas. May be the centre of the boundingbox (enclosing rectangle) or an arbitrary point. Angle is in degrees and counter-clockwise in the coördinate system(from the x-axis to the y-axis) and visually on canvas clock-wise.
             deriving (Show, Eq)
 
 data RotatePoint = AroundCenter
                  | AroundPoint Point
                 deriving (Show, Eq)
               
-data BoundingBox = BoundingBox UpperLeft UpperRight LowerRight LowerLeft
+data BoundingBox = BoundingBox LowerLeft UpperLeft UpperRight LowerRight -- ^| The point indications are from the perspective of a regular Cartesian coördinate system.
                 deriving (Show, Eq)
                          
 

@@ -30,32 +30,36 @@ drawTreesPostProcessor :: PostProcessor
 drawTreesPostProcessor shared iostate (OutDrawTrees (DrawTrees canvasId trees)) = return (shared, iostate, [OutBasicShapes $ DrawShapes canvasId [shapeTrees]])
                                                                                 where
-                                                                                    shapeTrees = showGeneralTreeList (map generalizeTree trees)
+                                                                                    (shapeTrees, _, _) = showGeneralTreeList trees
 drawTreesPostProcessor shared iostate out = return (shared, iostate, [out])
 
 
-showGeneralTreeList :: [GeneralTree] -> Shape
+maxWidth :: Int
+maxWidth = 1024
+
+showGeneralTreeList :: [GeneralTree] -> (Shape, RightOffset, BottomOffset)
 showGeneralTreeList list = showGeneralTreeList' 0 0 0 0 list
 
-showGeneralTreeList' :: LeftOffset -> TopOffset -> Float -> Int -> [GeneralTree] -> Shape
-showGeneralTreeList' _ _ _ _ [] = CompositeShape [] Nothing Nothing
-showGeneralTreeList' left top maxBottom i (x:xs) | right <= 1024 = CompositeShape (text:gtree:gtrees) Nothing Nothing
-                                                 | width > 1024  = CompositeShape (text:gtree:gtrees) Nothing Nothing
-                                                 | otherwise     = showGeneralTreeList' 0 maxBottom' maxBottom' i (x:xs)
+showGeneralTreeList' :: LeftOffset -> TopOffset -> Float -> Int -> [GeneralTree] -> (Shape, RightOffset, BottomOffset)
+showGeneralTreeList' _ _ _ _ [] = (CompositeShape [] Nothing Nothing, 0, 0)
+showGeneralTreeList' left top maxBottom i (x:xs) | right <= 1024 || width > 1024 = (CompositeShape (treeShapes ++ gtrees) Nothing Nothing, rightOff', botOff')
+                                                 | otherwise = showGeneralTreeList' 0 maxBottom' maxBottom' i (x:xs)
                                                where
                                                    maxBottom' = max maxBottom bottom
-                                                   (ltree, right, bottom) = layoutGeneralTree left top x
-                                                   gtree = printTree ltree
-                                                   CompositeShape gtrees _ _ = showGeneralTreeList' (right + marginBetweenTrees) top maxBottom' i' xs
+                                                   (CompositeShape treeShapes _ _, right, bottom) = showGeneralTree left top i x
+                                                   (CompositeShape gtrees _ _, rightOff, botOff) = showGeneralTreeList' (right + marginBetweenTrees) top maxBottom' i' xs
                                                    i' = i + 1
-                                                   text = treeIndex i (left, top)
                                                    width = right - left
-
-
-instance GeneralizeTree Tree where
-    generalizeTree (TRBTree tree)    = generalizeTree tree
-    generalizeTree (TRoseTree tree)  = generalizeTree tree
+                                                   rightOff' = max rightOff right
+                                                   botOff'   = max bottom botOff
 
+       
+showGeneralTree :: LeftOffset -> TopOffset -> Int -> GeneralTree -> (Shape, RightOffset, BottomOffset)
+showGeneralTree left top i tree = (CompositeShape [treeIndexShape, treeShape] Nothing Nothing, right, bottom)
+                                where
+                                    (ltree, right, bottom) = layoutGeneralTree left top tree
+                                    treeShape = printTree ltree
+                                    treeIndexShape = treeIndex i (left, top)
 
 instance GeneralizeTree RBTree where
     generalizeTree (RBNode col _ []) = GeneralTreeBox content []
@@ -83,19 +87,19 @@                                                 line = GeneralLine (0,0,0, 255)   
                         
 rbExampleTree = RBNode NodeBlack "12"
-                        [ RBNode NodeRed "11"
-                                    [ RBNode NodeBlack "16"
+                        [ RBNode NodeRed "10"
+                                    [ RBNode NodeBlack "9"
                                                 [ RBNode NodeBlack "" [],
                                                   RBNode NodeBlack "" []
                                                 ],
-                                      RBNode NodeBlack "24"
+                                      RBNode NodeBlack "11"
                                                 [RBNode NodeBlack "" [],
                                                  RBNode NodeBlack "" []
                                                 ]
                                     ],
                           RBNode NodeRed "13"
                                     [RBNode NodeBlack "36" [],
-                                     RBNode NodeBlack "28"
+                                     RBNode NodeBlack "42"
                                                [RBNode NodeRed "36"
                                                           [RBNode NodeBlack "" [],
                                                            RBNode NodeBlack "" []

@@ -4,12 +4,8 @@ import Eventloop.Utility.Trees.GeneralTree
 
 
-data DrawTreesOut = DrawTrees CanvasId [Tree]
+data DrawTreesOut = DrawTrees CanvasId [GeneralTree]
                   deriving (Show, Eq)
-
-data Tree = TRBTree RBTree
-          | TRoseTree RoseTree
-          deriving (Show, Eq)
              
           
 data NodeColor = NodeRed

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

@@ -0,0 +1,238 @@+module Eventloop.Module.Graphs.Graphs where
+
+import Eventloop.Module.Graphs.Types
+import qualified Eventloop.Module.Websocket.Canvas as C
+import qualified Eventloop.Module.Websocket.Mouse as M
+import qualified Eventloop.Module.Websocket.Keyboard as K
+import qualified Eventloop.Module.BasicShapes as BS
+import qualified Eventloop.Types.EventTypes as ET
+
+import Eventloop.Utility.Vectors
+
+
+defaultGraphsModuleConfiguration :: ET.EventloopModuleConfiguration
+defaultGraphsModuleConfiguration = ( ET.EventloopModuleConfiguration
+                                      graphsModuleIdentifier
+                                      defaultGraphsModuleIOState
+                                      Nothing
+                                      Nothing
+                                      (Just graphsPreProcessor)
+                                      (Just graphsPostProcessor)
+                                      Nothing
+                                      Nothing
+                                   )
+                                      
+defaultGraphsModuleIOState :: ET.IOState
+defaultGraphsModuleIOState = ET.NoState
+
+graphsModuleIdentifier :: ET.EventloopModuleIdentifier
+graphsModuleIdentifier = "graphs"
+                                      
+
+
+nodeRadius   = 20 :: Float                 
+textSize     = 16 :: Float
+textFont     = "Courier"
+xArrowSize   = 6 :: Float
+yArrowSize   = 6 :: Float
+weightHeight = 15 :: Float
+
+dimCanvasGraphs = (840,440) :: (Float, Float)
+roundDimCanvasGraphs = (round $ fst dimCanvasGraphs, round $ snd dimCanvasGraphs) :: (Int, Int)
+canvasGraphsWidth = fst dimCanvasGraphs
+canvasGraphsHeight = snd dimCanvasGraphs
+
+instructionsHeight = 200 :: Float
+instructionsBeginAt = instructionsHeight + canvasGraphsHeight
+canvasInstrWidth = canvasGraphsWidth
+canvasInstrHeight = instructionsHeight * 2 + canvasGraphsHeight
+dimCanvasInstr = (canvasInstrWidth, canvasInstrHeight)
+roundDimCanvasInstr = (round $ fst dimCanvasInstr, round $ snd dimCanvasInstr) :: (Int, Int)
+
+canvasIdGraphs = 1 :: C.CanvasId
+canvasIdInstructions = 2 :: C.CanvasId
+
+               
+-- | Checkes to see if there is a node on a certain position                
+onNode :: [Node] -> Pos -> Maybe Node
+onNode [] _ = Nothing
+onNode (n@(_, (nx, ny), _):ns) (x,y) | difference <= nodeRadius = Just n
+                                     | otherwise                = onNode ns (x,y)
+                                    where
+                                        dx         = nx - x
+                                        dy         = ny - y
+                                        difference = sqrt (dx^2 + dy^2)
+                 
+
+
+-- | Abstracts the standardized 'EventLoop.Types.EventTypes' to 'GraphsIn'
+graphsPreProcessor :: ET.PreProcessor
+graphsPreProcessor shared io (ET.InMouse (M.Mouse M.MouseCanvas 1 event (Point p)))
+    | x >=0 && y >= 0 && y <= canvasGraphsHeight && x <= canvasGraphsWidth = return (shared, io, [ET.InGraphs $ Mouse event p])
+    | otherwise = return (shared, io, [])
+    where
+        (x, y) = p
+    
+graphsPreProcessor shared io k@(ET.InKeyboard (K.Key key))
+    = return (shared, io, [k, ET.InGraphs $ Key key])
+    
+graphsPreProcessor shared io inEvent 
+    = return (shared, io, [inEvent])
+
+
+-- | Abstracts 'GraphsOut' back to 'BasicShapes' and 'Canvas' events
+graphsPostProcessor :: ET.PostProcessor
+graphsPostProcessor shared io (ET.OutGraphs SetupGraphs)
+    = return (shared, io, [ ET.OutCanvas $ C.SetupCanvas canvasIdGraphs  1 roundDimCanvasGraphs (C.CSSPosition C.CSSFromCenter (C.CSSPercentage 50, C.CSSPercentage 50))
+                          , ET.OutCanvas $ C.SetupCanvas canvasIdInstructions 2 roundDimCanvasInstr (C.CSSPosition C.CSSFromCenter (C.CSSPercentage 50, C.CSSPercentage 50))
+                          ])
+        
+                   
+graphsPostProcessor shared io (ET.OutGraphs (DrawGraph graph))
+    = return (shared, io, [ ET.OutCanvas $ C.CanvasOperations canvasIdGraphs [C.Clear C.ClearCanvas]
+                          , ET.OutBasicShapes $ BS.DrawShapes canvasIdGraphs shapes
+                          ])
+    where
+        shapes = graphToShapes graph
+    
+graphsPostProcessor shared io (ET.OutGraphs (Instructions is))
+    = return (shared, io, [ ET.OutCanvas $ C.CanvasOperations canvasIdInstructions [C.Clear C.ClearCanvas]
+                          , ET.OutBasicShapes $ BS.DrawShapes canvasIdInstructions shapes
+                          ])
+    where
+        startPLine  = Point (0, 0)
+        endPLine    = Point (canvasGraphsWidth, 0)
+        lineHeight  = 2
+        lineShape   = BS.BaseShape (BS.Line startPLine endPLine) lineHeight (0,0,0,255) Nothing
+        textShape   = (\line p -> BS.BaseShape (textPrim line p) 0 (0,0,0,0) Nothing) 
+        textPrim    = (\line p -> BS.Text line textFont textSize p (0,0,0,255))
+        textMargin        = 2
+        heights           = iterate ((+) (textSize + textMargin)) lineHeight
+        isAndHeights      = zip is heights
+        instructionShapes = map (\(line, top) -> textShape line $ Point (0.5 * canvasGraphsWidth, top)) isAndHeights
+        shapes            = [BS.CompositeShape (lineShape:instructionShapes) (Just (Point (0, instructionsBeginAt))) Nothing]
+
+graphsPostProcessor shared io out 
+    = return (shared, io, [out])  
+  
+-- | Translates color datatype to RGBA codes
+colorToRGBAColor :: Color -> BS.Color
+colorToRGBAColor Red    = (255, 0, 0, 255)
+colorToRGBAColor Blue   = (0, 0, 255, 255)
+colorToRGBAColor Green  = (0, 255, 0, 255)
+colorToRGBAColor Purple = (255, 0, 255, 255)
+colorToRGBAColor Grey   = (125, 125, 125, 255)
+colorToRGBAColor Yellow = (255, 255, 0, 255)
+colorToRGBAColor Orange = (255, 125, 0, 255)
+colorToRGBAColor Black  = (0, 0, 0, 255)
+colorToRGBAColor White  = (255, 255, 255, 255)
+     
+     
+-- | Translates the thickness to a float           
+thicknessToFloat :: Thickness -> BS.StrokeLineThickness
+thicknessToFloat Thick = 3.0
+thicknessToFloat Thin  = 1.0
+
+
+findNode :: [Node] -> Label -> Node
+findNode [] l = error ("Tried to find a node in the graph with label '" ++ (show l) ++ "' but could not find it!")
+findNode (n@(ln, _, _):ns) l | l == ln = n
+                             | otherwise = findNode ns l
+                             
+
+graphToShapes :: Graph -> [BS.Shape]
+graphToShapes graph
+    = (concat nodeShapes) ++ (concat edgeShapes)
+    where
+        allNodes = nodes graph
+        allEdges = edges graph
+        isDirected = directed graph
+        isWeighted = weighted graph
+        allEdgesWithNodes = map (\e@(l1, l2,_,_,_) -> (findNode allNodes l1, findNode allNodes l2, e)) allEdges
+        nodeShapes = map nodeToShapes allNodes
+        edgeShapes = map (\(n1, n2, e) -> edgeToShapes n1 n2 e isDirected isWeighted) allEdgesWithNodes
+
+
+nodeToShapes :: Node -> [BS.Shape]
+nodeToShapes (l, p, col)
+    = [BS.BaseShape nodePrim 2 (0,0,0,255) Nothing, BS.BaseShape textPrim 3 (0,0,0,255) Nothing]
+    where
+        color = colorToRGBAColor col
+        lStr = [l]
+        nodePrim = BS.Circle (Point p) nodeRadius color
+        textPrim = BS.Text lStr textFont textSize (Point p) (0,0,0,255)
+
+        
+edgeToShapes :: Node -> Node -> Edge -> Directed -> Weighted -> [BS.Shape]
+edgeToShapes (_, p1, _) (_, p2, _) (_, _, col, w, thick) directed weighted
+    = lineShape:(weightShapes ++ directShapes)
+    where
+        directShapes | directed == Directed   = [arrowShape arrow1Prim, arrowShape arrow2Prim]
+                     | directed == Undirected = []
+                    where
+                        arrow1Prim = BS.Line (Point arrowStart) (Point arrow1End)
+                        arrow2Prim = BS.Line (Point arrowStart) (Point arrow2End)
+                        arrowShape prim = BS.BaseShape prim thickness color Nothing
+        weightShapes | weighted == Weighted   = [BS.BaseShape weightPrim 0 (0,0,0,0) Nothing]
+                     | weighted == Unweighted = []
+                    where
+                        wStr = show w
+                        weightPrim = BS.Text wStr textFont textSize (Point textPos) (0,0,0,255)
+        lineShape = BS.BaseShape linePrim thickness color Nothing
+                where
+                    linePrim = BS.Line (Point lineStart) (Point lineEnd)
+        thickness = thicknessToFloat thick
+        color = colorToRGBAColor col
+        -- Margin line vector stuff
+        lineVector         = vectorize p1 p2
+        lineVector'        = vectorize p2 p1
+        lineStart          = posOnVector nodeRadius lineVector p1
+        lineEnd            = posOnVector nodeRadius lineVector' p2
+        -- Arrow directed vector stuff
+        arrowPerpStart     = posOnVector xArrowSize lineVector' lineEnd  
+        upPerpLineVector   = upPerpendicularTo p1 p2
+        downPerpLineVector = downPerpendicularTo p1 p2
+        arrowStart         = lineEnd
+        arrow1End          = posOnVector yArrowSize upPerpLineVector arrowPerpStart  
+        arrow2End          = posOnVector yArrowSize downPerpLineVector arrowPerpStart
+        -- Weight vector stuff
+        halfSize          = vectorSize lineVector' / 2
+        textPerpStart     = posOnVector halfSize lineVector p1
+        textPos           = posOnVector weightHeight upPerpLineVector textPerpStart
+        
+
+-- | Returns the point when making a step f long from the point start in the direction of the vector. The length between start pos and result pos is always f.
+posOnVector :: Float -> Vector -> Pos -> Pos
+posOnVector f (xv, yv) (xStart, yStart) = (x, y)
+                                        where
+                                            x        = xStart + fraction * xv
+                                            y        = yStart + fraction * yv
+                                            fraction = f / size
+                                            size     = vectorSize (xv, yv)
+
+-- | Vector from p1 to p2 
+vectorize :: Pos -> Pos -> Vector
+vectorize (x1, y1) (x2, y2) = (x2 - x1, y2 - y1)
+
+
+-- | Returns the vector perpendicular on the given vector between the 2 points. Always has positive y and vector length 1; y is inverted in canvas
+downPerpendicularTo :: Pos -> Pos -> Vector
+downPerpendicularTo (x1, y1) (x2, y2) | y2 > y1   = ((-1) * sign * (abs yv) / size, (abs xv) / size)
+                                    | otherwise = (       sign * (abs yv) / size, (abs xv) / size)
+                                      where
+                                          (xv, yv) = vectorize (x1, y1) (x2, y2)
+                                          size     = vectorSize (xv, yv)
+                                          sign     = case xv of
+                                                        0 -> (-1)
+                                                        _ -> xv / (abs xv)
+                                            
+                                            
+-- | Returns the vector perpendicular on the given vector between the 2 points. Always has negative y and vector length 1; y is inverted in canvas
+upPerpendicularTo :: Pos -> Pos -> Vector
+upPerpendicularTo p1 p2 = ((-1) * xp, (-1) * yp)
+                        where
+                            (xp, yp) = downPerpendicularTo p1 p2
+                          
+-- | Returns the size of the vector                          
+vectorSize :: Vector -> Float
+vectorSize (x, y) = sqrt (x^2 + y^2)                                            

@@ -0,0 +1,58 @@+module Eventloop.Module.Graphs.Types
+    ( module Eventloop.Module.Graphs.Types
+    , M.MouseEvent(..)
+    , M.MouseButton(..)
+    ) where
+
+import qualified Eventloop.Module.Websocket.Mouse.Types as M
+    
+type Pos = (Float, Float)
+type Vector = (Float, Float)
+
+
+data GraphsIn = Mouse M.MouseEvent Pos
+              | Key [Char]
+              deriving (Eq, Show)
+    
+data GraphsOut = SetupGraphs
+               | DrawGraph Graph
+               | Instructions [String]
+               deriving (Eq, Show)
+              
+----- Graph -----
+type Label   = Char
+type Weight  = Float
+
+type Node = (Label, Pos, Color)
+type Edge = (Label, Label, Color, Weight, Thickness)
+
+data Graph = Graph
+            { nodes    :: [Node]
+            , edges    :: [Edge]
+            , directed :: Directed
+            , weighted :: Weighted
+            } deriving (Eq, Show)
+            
+----- Graph Graphical -----            
+data Color = Red
+           | Blue
+           | Green
+           | Purple
+           | Grey
+           | Yellow
+           | Orange
+           | Black
+           | White
+           deriving (Eq, Show)
+
+data Thickness = Thin
+               | Thick
+               deriving (Eq, Show)
+
+data Directed  = Directed
+               | Undirected
+                deriving (Eq, Show)
+               
+data Weighted  = Weighted
+               | Unweighted
+               deriving (Eq, Show)

@@ -34,6 +34,7 @@ canvasInitializer :: Initializer
 canvasInitializer sharedIO _ = do
                                 (comRecvBuffer, clientConn, serverSock) <- WS.setupWebsocketConnection ipAddress  canvasPort
+                                putStrLn "Canvas connection successfull!"
                                 userRecvBuffer <- newMVar []
                                 sysRecvBuffer <- newEmptyMVar
                                 routerThreadId <- forkIO (router comRecvBuffer userRecvBuffer sysRecvBuffer)

@@ -81,11 +81,11 @@ 
 
 instance ToJSON CanvasOut where
-    toJSON d@(SetupCanvas canvasId zIndex screenDimensions canvasPosition) = operationObject (toOpcode d) [ toJSON canvasId
-                                                                                                          , toJSON zIndex
-                                                                                                          , toJSON screenDimensions
-                                                                                                          , toJSON canvasPosition
-                                                                                                          ]
+    toJSON d@(SetupCanvas canvasId zIndex screenDimensions cssPosition) = operationObject (toOpcode d) [ toJSON canvasId
+                                                                                                       , toJSON zIndex
+                                                                                                       , toJSON screenDimensions
+                                                                                                       , toJSON cssPosition
+                                                                                                       ]
     toJSON d@(TeardownCanvas canvasId) = operationObject (toOpcode d) [toJSON canvasId]
     toJSON d@(CanvasOperations canvasId canvasOperations) = operationObject (toOpcode d) [ toJSON canvasId
                                                                                          , toJSON canvasOperations
@@ -101,10 +101,11 @@                                                                                                                , toJSON pathStroke
                                                                                                                , toJSON pathFill
                                                                                                                ]
-    toJSON d@(DrawText canvasText screenPoint textRender) = operationObject (toOpcode d) [ toJSON canvasText
-                                                                                         , toJSON screenPoint
-                                                                                         , toJSON textRender
-                                                                                         ]
+    toJSON d@(DrawText canvasText screenPoint textStroke textFill) = operationObject (toOpcode d) [ toJSON canvasText
+                                                                                                  , toJSON screenPoint
+                                                                                                  , toJSON textStroke
+                                                                                                  , toJSON textFill
+                                                                                                  ]
     toJSON d@(DoTransform canvasTransform) = operationObject (toOpcode d) [toJSON canvasTransform]
     toJSON d@(Clear clearPart) = operationObject (toOpcode d) [toJSON clearPart]
 
@@ -133,7 +134,9 @@ 
     
 instance ToJSON PathStroke where
-    toJSON d@(PathStroke pathRenderStrokeStyle) = operationObject (toOpcode d) [toJSON pathRenderStrokeStyle]
+    toJSON d@(PathStroke screenLineThickness pathRenderStrokeStyle) = operationObject (toOpcode d) [ toJSON screenLineThickness
+                                                                                                   , toJSON pathRenderStrokeStyle
+                                                                                                   ]
     toJSON d = operationObject (toOpcode d) []
 
     
@@ -190,13 +193,18 @@                                                                        ]
 
     
-instance ToJSON TextRender where
-    toJSON d@(TextStroke textRenderStyle) = operationObject (toOpcode d) [ toJSON textRenderStyle
-                                                                         ]
-    toJSON d@(TextFill textRenderStyle)   = operationObject (toOpcode d) [ toJSON textRenderStyle
-                                                                         ]
+instance ToJSON TextStroke where
+    toJSON d@(TextStroke screenLineThickness textRenderStyle) = operationObject (toOpcode d) [ toJSON screenLineThickness
+                                                                                             , toJSON textRenderStyle
+                                                                                             ]
+    toJSON d@(NoTextStroke) = operationObject (toOpcode d) []
 
+instance ToJSON TextFill where
+    toJSON d@(TextFill textRenderStyle) = operationObject (toOpcode d) [ toJSON textRenderStyle
+                                                                       ]
+    toJSON d@(NoTextFill) = operationObject (toOpcode d) []
     
+    
 instance ToJSON Alignment where
     toJSON d = operationObject (toOpcode d) []
 
@@ -209,7 +217,15 @@     toJSON d@(SetTransform tm)       = operationObject (toOpcode d) [toJSON tm]
     toJSON d                         = operationObject (toOpcode d) []
     
+    
+instance ToJSON CSSPosition where
+    toJSON d@(CSSPosition cssBindPoint cssMeasurements) = operationObject (toOpcode d) [ toJSON cssBindPoint
+                                                                                       , toJSON cssMeasurements
+                                                                                       ]
 
+instance ToJSON CSSBindPoint where
+    toJSON d = operationObject (toOpcode d) []
+                                                                                      
 instance ToJSON CSSUnit where
     toJSON d@(CSSPixels i)     = operationObject (toOpcode d) [toJSON i]
     toJSON d@(CSSPercentage i) = operationObject (toOpcode d) [toJSON i]

@@ -17,7 +17,7 @@ 
 instance ToOpcode CanvasOperation where
     toOpcode (DrawPath _ _ _ _) = 301
-    toOpcode (DrawText _ _ _)   = 302
+    toOpcode (DrawText _ _ _ _) = 302
     toOpcode (DoTransform _)    = 303
     toOpcode (Clear _)          = 304
 
@@ -25,18 +25,18 @@     toOpcode (MoveTo _)              = 401
     toOpcode (LineTo _)              = 402
     toOpcode (BezierCurveTo _ _ _)   = 403
-    toOpcode (QuadraticCurveTo _ _) = 404
+    toOpcode (QuadraticCurveTo _ _)  = 404
     toOpcode (ArcTo _ _ _)           = 405
     toOpcode (Arc _ _ _)             = 406
     toOpcode (Rectangle _ _)         = 407
 
 instance ToOpcode PathStroke where
-    toOpcode (PathStroke _) = 501
-    toOpcode (PathNoStroke) = 502
+    toOpcode (PathStroke _ _) = 501
+    toOpcode (NoPathStroke) = 502
 
 instance ToOpcode PathFill where
     toOpcode (PathFill _) = 601
-    toOpcode (PathNoFill) = 602
+    toOpcode (NoPathFill) = 602
 
 instance ToOpcode RenderStyle where
     toOpcode (CanvasColor _)      = 701
@@ -63,10 +63,14 @@ instance ToOpcode Font where
     toOpcode (Font _ _) = 1301
     
-instance ToOpcode TextRender where
-    toOpcode (TextStroke _) = 1401
-    toOpcode (TextFill _)   = 1402
+instance ToOpcode TextStroke where
+    toOpcode (TextStroke _ _) = 1401
+    toOpcode (NoTextStroke)   = 1402
     
+instance ToOpcode TextFill where
+    toOpcode (TextFill _) = 2401
+    toOpcode (NoTextFill) = 2402
+    
 instance ToOpcode Alignment where
     toOpcode (AlignLeft)   = 1501
     toOpcode (AlignRight)  = 1502
@@ -90,4 +94,11 @@     
 instance ToOpcode ClearPart where
     toOpcode (ClearRectangle _ _) = 1901
-    toOpcode (ClearCanvas)    = 1902+    toOpcode (ClearCanvas)        = 1902
+    
+instance ToOpcode CSSPosition where
+    toOpcode (CSSPosition _ _) = 2201
+    
+instance ToOpcode CSSBindPoint where
+    toOpcode (CSSFromCenter)  = 2301
+    toOpcode (CSSFromDefault) = 2302 

@@ -46,6 +46,8 @@ type ScaleX = ScaleUnit
 type ScaleY = ScaleUnit
 
+type ScreenLineThickness = ScreenMetric
+
 type FontFamily = [Char]
 type FontSize = Int -- In Pixels
 
@@ -85,12 +87,7 @@ -}
 
 {- |Opcode: 0200-}
-type CanvasPositionLeft = CSSUnit
-type CanvasPositionRight = CSSUnit
-
-type CanvasPosition = (CanvasPositionLeft, CanvasPositionRight)
-
-data CanvasOut = SetupCanvas CanvasId ZIndex ScreenDimensions CanvasPosition {- ^Opcode: 0201-}
+data CanvasOut = SetupCanvas CanvasId ZIndex ScreenDimensions CSSPosition {- ^Opcode: 0201-}
                | TeardownCanvas CanvasId {- ^Opcode: 0202-}
                | CanvasOperations CanvasId [CanvasOperation] {- ^Opcode: 0203-}
                | MeasureText CanvasId CanvasText {- ^Opcode: 0204-}
@@ -98,7 +95,7 @@                
 {- |Opcode: 0300-}
 data CanvasOperation = DrawPath ScreenStartingPoint [ScreenPathPart] PathStroke PathFill {- ^Opcode: 0301 -}
-                     | DrawText CanvasText ScreenPoint TextRender {- ^Opcode: 0302 -}
+                     | DrawText CanvasText ScreenPoint TextStroke TextFill {- ^Opcode: 0302 -}
                      | DoTransform CanvasTransform {- ^Opcode: 0303 -}
                      | Clear ClearPart {- ^Opcode: 0304 -}
                      deriving (Eq, Show)
@@ -117,15 +114,15 @@ {- |Opcode: 0500-}
 type PathRenderStrokeStyle = RenderStyle
 
-data PathStroke = PathStroke PathRenderStrokeStyle {- ^Opcode: 0501-}
-                | PathNoStroke {- ^Opcode: 0502-}
+data PathStroke = PathStroke ScreenLineThickness PathRenderStrokeStyle {- ^Opcode: 0501-}
+                | NoPathStroke {- ^Opcode: 0502-}
                 deriving (Eq, Show)
 
 {- |Opcode: 0600-}
 type PathRenderFillStyle = RenderStyle
 
 data PathFill = PathFill PathRenderFillStyle {- ^Opcode: 0601-}
-              | PathNoFill {- ^Opcode: 0602-}
+              | NoPathFill {- ^Opcode: 0602-}
               deriving (Eq, Show)
 
 {- |Opcode: 0700-}
@@ -169,10 +166,15 @@ type TextStrokeRenderStyle = RenderStyle
 type TextFillRenderStyle = RenderStyle
 
-data TextRender = TextStroke TextStrokeRenderStyle {- ^Opcode: 1401-}
-                | TextFill TextFillRenderStyle {- ^Opcode: 1402-}
+data TextStroke = TextStroke ScreenLineThickness TextStrokeRenderStyle {- ^Opcode: 1401-}
+                | NoTextStroke {- ^Opcode: 1402-}
                 deriving (Eq, Show)
 
+{- |Opcode: 2400-}
+data TextFill = TextFill TextFillRenderStyle {- ^Opcode: 2401-}
+              | NoTextFill {- ^Opcode: 2402-}
+              deriving (Eq, Show)
+
 {- |Opcode: 1500-}
 data Alignment = AlignLeft {- ^Opcode: 1501-}
                | AlignRight {- ^Opcode: 1502-}
@@ -196,6 +198,20 @@                      | ResetTransform {- ^Opcode: 1608-}
                      deriving (Eq, Show)
 
+{- CSS Position of DOM elements -}
+{- |Opcode: 2200-}
+type CSSLeftOffset = CSSUnit
+type CSSTopOffset = CSSUnit
+type CSSMeasurements = (CSSLeftOffset, CSSTopOffset)
+
+data CSSPosition = CSSPosition CSSBindPoint CSSMeasurements {- ^Opcode: 2201-}
+                 deriving (Eq, Show)
+
+{- |Opcode: 2300-}
+data CSSBindPoint = CSSFromCenter {- ^Opcode: 2301-}
+                  | CSSFromDefault {- ^Opcode: 2302 Usually this is the top left corner of the element -}
+                  deriving (Eq, Show)
+                     
 {- |Opcode: 1800-}
 data CSSUnit = CSSPixels Int {- ^Opcode: 1801-}
              | CSSPercentage Int {- ^Opcode: 1802-}

@@ -46,6 +46,7 @@ keyboardInitializer :: Initializer
 keyboardInitializer sharedIO _ = do
                                     (recvBuffer, clientConn, serverSock) <- WS.setupWebsocketConnection ipAddress  keyboardPort
+                                    putStrLn "Keyboard connection successfull"
                                     return (sharedIO, KeyboardState recvBuffer clientConn serverSock)
 
                             

@@ -20,6 +20,7 @@ import Eventloop.Types.Common
 import Eventloop.Module.Websocket.Mouse.Types
 import Eventloop.Utility.Config
+import Eventloop.Utility.Vectors
 
 
 defaultMouseModuleConfiguration :: EventloopModuleConfiguration
@@ -40,40 +41,56 @@ mouseModuleIdentifier :: EventloopModuleIdentifier
 mouseModuleIdentifier = "mouse"
 
-     
-instance FromJSON Mouse where
-    parseJSON (Object v) = (v .: "type") >>= (parseMouseEvent v)
-
+instance FromJSON MouseIn where
+    parseJSON vO@(Object v)
+        = do
+            mouseEvent <- parseJSON vO :: Parser MouseEvent
+            mouseType  <- parseJSON vO :: Parser MouseType
+            point      <- parseJSON vO :: Parser Point
+            id         <- v .: "id"    :: Parser NumericId
+            return $ Mouse mouseType id mouseEvent point
     
-parseMouseEvent :: Object -> [Char] -> Parser Mouse
-parseMouseEvent v eventType = case eventType of "click"      -> Click <$> buttonP <*> posP
-                                                "dblclick"   -> DoubleClick <$> buttonP <*> posP
-                                                "mousedown"  -> MouseDown <$> buttonP <*> posP
-                                                "mouseup"    -> MouseUp <$> buttonP <*> posP
-                                                "mouseenter" -> MouseEnter <$> posP
-                                                "mouseleave" -> MouseLeave <$> posP
-                                                "mousemove"  -> MouseMove <$> posP
-                                                where
-                                                    buttonP = parseMouseButton <$> (v.: "button")
-                                                    posP = parseMousePosition v 
-   
+    
+instance FromJSON MouseType where
+    parseJSON (Object v)
+        = do
+            type' <- v .: "elementType" :: Parser String
+            return $ case type' of "canvas" -> MouseCanvas
+                                   "svg"    -> MouseSVG
+    
+instance FromJSON MouseEvent where
+    parseJSON (Object v)
+        =   do
+                eventType <- v .: "mouseEventType" :: Parser String
+                button <- parseJSON (Object v) :: Parser MouseButton
+                return $ case eventType of "click"      -> Click button
+                                           "dblclick"   -> DoubleClick button
+                                           "mousedown"  -> MouseDown button
+                                           "mouseup"    -> MouseUp button
+                                           "mouseenter" -> MouseEnter
+                                           "mouseleave" -> MouseLeave
+                                           "mousemove"  -> MouseMove
    
-parseMouseButton :: [Char] -> MouseButton
-parseMouseButton "left"   = MouseLeft
-parseMouseButton "middle" = MouseMiddle
-parseMouseButton "right"  = MouseRight
-
+instance FromJSON MouseButton where
+    parseJSON (Object v)
+        = do
+            button <- v .: "button" :: Parser String
+            return $ case button of "left"   -> MouseLeft
+                                    "middle" -> MouseMiddle
+                                    "right"  -> MouseRight
 
-parseMousePosition :: Object -> Parser Point
-parseMousePosition v = (\x y -> (x, y)) <$> xP <*> yP
-                    where
-                        xP = v .: "x"
-                        yP = v .: "y"
+instance FromJSON Point where
+    parseJSON (Object v)
+        = do
+            x <- v .: "x"
+            y <- v .: "y"
+            return $ Point (x, y)
     
     
 mouseInitializer :: Initializer
 mouseInitializer sharedIO _ = do
                                 (recvBuffer, clientConn, serverSock) <- WS.setupWebsocketConnection ipAddress  mousePort
+                                putStrLn "Mouse connection succesfull"
                                 return (sharedIO, MouseState recvBuffer clientConn serverSock)
 
 
@@ -83,7 +100,7 @@                                             return (sharedIO, mouseState, map ((.) InMouse messageToMouseIn) messages)
 
                                     
-messageToMouseIn :: WS.Message -> Mouse
+messageToMouseIn :: WS.Message -> MouseIn
 messageToMouseIn message = fromJust.decode $ BL.pack message
 
 

@@ -1,17 +1,23 @@ module Eventloop.Module.Websocket.Mouse.Types where
 
 import Eventloop.Types.Common
+import Eventloop.Utility.Vectors
 
-type Point = (Float, Float)
+data MouseIn = Mouse MouseType NumericId MouseEvent Point
+             deriving (Eq, Show)
 
-data Mouse = Click MouseButton Point
-           | DoubleClick MouseButton Point
-           | MouseMove Point
-           | MouseDown MouseButton Point
-           | MouseUp MouseButton Point
-           | MouseEnter Point
-           | MouseLeave Point
-           deriving (Eq, Show)
+data MouseType = MouseCanvas
+               | MouseSVG
+               deriving (Eq, Show)
+
+data MouseEvent = Click MouseButton
+                | DoubleClick MouseButton
+                | MouseMove
+                | MouseDown MouseButton
+                | MouseUp MouseButton
+                | MouseEnter
+                | MouseLeave
+                deriving (Eq, Show)
          
 data MouseButton = MouseLeft 
                  | MouseRight 

@@ -16,6 +16,7 @@ import Eventloop.Module.StdIn.Types
 import Eventloop.Module.StdOut.Types
 import Eventloop.Module.Timer.Types
+import Eventloop.Module.Graphs.Types
 
 
 
@@ -50,11 +51,12 @@ 
 data In = Start
         | InKeyboard Keyboard
-        | InMouse Mouse
+        | InMouse MouseIn
         | InFile FileIn
         | InTimer TimerIn
         | InStdIn StdInIn
         | InCanvas CanvasIn
+        | InGraphs GraphsIn
         deriving (Eq, Show)
 
 
@@ -65,6 +67,7 @@          | OutCanvas CanvasOut
          | OutBasicShapes BasicShapesOut
          | OutDrawTrees DrawTreesOut
+         | OutGraphs GraphsOut
          | Stop
          deriving (Eq, Show)
 
@@ -105,7 +108,7 @@ -- API module types
 type APIName = [Char]
 type Parameter = [Char]
-type Value = [Char]
-type Parameters =[(Parameter, Value)]
+--type Value = [Char]
+--type Parameters =[(Parameter, Value)]
          
 

@@ -10,6 +10,7 @@ import Network.WebSockets hiding (Message)
 import Control.Concurrent.MVar
 import Control.Concurrent
+import Control.Exception
     
 import Eventloop.Utility.Websockets hiding ( ReceiveBuffer
                                            , setupWebsocketConnection
@@ -32,8 +33,7 @@                                                         
 spawnReader :: BufferedReceiveBuffer -> Connection -> IO ThreadId
 spawnReader recvBuffer conn = do
-                                forkIO (readIntoBuffer recvBuffer conn)
-                                --Spawn reader but with function that catches closeRequest exception and closes the connection
+                                forkIO (handle handleCloseRequestException $ readIntoBuffer recvBuffer conn)
                                                         
                                                         
 readIntoBuffer :: BufferedReceiveBuffer -> Connection -> IO ()

@@ -127,7 +127,7 @@ 
 
 treeIndex :: Int -> Offset -> Shape
-treeIndex i (x, y) = BaseShape (Text iStr "Courier" 20 p) ((0,0,0,0), (255,75,75, 255)) Nothing
+treeIndex i (x, y) = BaseShape (Text iStr "Courier" 20 p (255,75,75, 255)) 1 (0,0,0,0) Nothing
                 where
                     iStr = show i
                     (wText, hText) = textSize iStr

@@ -19,7 +19,8 @@ 
 
 marginLine = 3 :: Float
-lineThickness = 2 :: Float
+lineThickness = 1 :: Float
+textThickness = 1 :: Float
 textFont = "Courier"
 
 
@@ -35,12 +36,12 @@ 
                                                     
 printNodeContent :: Offset -> LayoutNodeContent -> Shape
-printNodeContent (xOffset, yOffset) (LayoutNodeText fillColor p text (_, height)) = BaseShape (Text text textFont height ((Point (xOffset, yOffset)) |+| p)) ((0,0,0,0), fillColor) Nothing
-printNodeContent (xOffset, yOffset) (LayoutNode fillColor p r)                    = BaseShape (Circle ((Point (xOffset, yOffset)) |+| p) r) ((0,0,0,0), fillColor) Nothing
+printNodeContent (xOffset, yOffset) (LayoutNodeText fillColor p text (_, height)) = BaseShape (Text text textFont height ((Point (xOffset, yOffset)) |+| p) fillColor) textThickness (0,0,0,0) Nothing
+printNodeContent (xOffset, yOffset) (LayoutNode fillColor p r)                    = BaseShape (Circle ((Point (xOffset, yOffset)) |+| p) r fillColor) lineThickness (0,0,0,0) Nothing
 
 
 printLine :: Point -> (LayoutLine, LayoutTree) -> Shape
-printLine startPoint ((LayoutLine lineColor),(LBox point topConnect _ _ _)) = BaseShape (Line startMarg endMarg) (lineColor, (0,0,0,0)) Nothing
+printLine startPoint ((LayoutLine lineColor),(LBox point topConnect _ _ _)) = BaseShape (Line startMarg endMarg) lineThickness lineColor Nothing
                                                                         where
                                                                             startMarg = marginizeLinePoints marginLine startPoint endPoint
                                                                             endMarg   = marginizeLinePoints marginLine endPoint startPoint

@@ -38,7 +38,10 @@                        
 originPoint = Point (0,0)
 
+class Translate a where
+    translate :: Point -> a -> a
 
+
 class (RotateLeftAround a) => Vector2D a where
     (|+|) :: a -> a -> a
     (|-|) :: a -> a -> a
@@ -51,7 +54,7 @@     
 instance Vector2D Point where
     (Point (x1, y1)) |+| (Point (x2, y2)) = Point (x1 + x2, y1 + y2)
-    (Point (x1, y1)) |-| (Point (x2, y2)) = Point (x2 - x1, y2 - y1)
+    (Point (x1, y1)) |-| (Point (x2, y2)) = Point (x1 - x2, y1 - y2)
     negateVector (Point (x, y)) = Point (-x, -y)
 
     

@@ -22,17 +22,27 @@ createBindListenServerSocket host port = do
                                         host' <- S.inet_addr host
                                         socket <- S.socket S.AF_INET S.Stream S.defaultProtocol
+                                        --Prelude.putStrLn "created socket"
                                         S.setSocketOption socket S.ReuseAddr 1
+                                        --Prelude.putStrLn "set option"
                                         S.bindSocket socket (S.SockAddrInet (fromIntegral port) host')
+                                        --Prelude.putStrLn "binded it"
+                                        --threadDelay 500000
                                         S.listen socket 5
+                                        --threadDelay 500000
+                                        --Prelude.putStrLn "listening"
                                         return socket
 
                                         
 acceptFirstConnection :: S.Socket -> IO Connection
 acceptFirstConnection serverSocket = do
+                                        --Prelude.putStrLn "before accept"
                                         (clientSocket, clientAddr) <- S.accept serverSocket
+                                        --Prelude.putStrLn "accepted it!"
                                         pendingConnection <- makePendingConnection clientSocket defaultConnectionOptions
+                                        --Prelude.putStrLn "made pending connection"
                                         connection <- acceptRequest pendingConnection
+                                        --Prelude.putStrLn "accepted connection"
                                         return connection
 
                                         
@@ -47,16 +57,16 @@                                         
 spawnReader :: ReceiveBuffer -> Connection -> IO ThreadId
 spawnReader recvBuffer conn = do
-                                forkIO (readIntoBuffer recvBuffer conn)
+                                forkIO (handle handleCloseRequestException $ readIntoBuffer recvBuffer conn)
                                 
                                 
 readIntoBuffer :: ReceiveBuffer -> Connection -> IO ()
-readIntoBuffer recvBuffer conn = handle handleCloseRequestException $ do
-                                                                        textMessage <- receiveData conn
-                                                                        let
-                                                                            message = T.unpack textMessage
-                                                                        putMVar recvBuffer message
-                                                                        readIntoBuffer recvBuffer conn
+readIntoBuffer recvBuffer conn =  do
+                                    textMessage <- receiveData conn
+                                    let
+                                        message = T.unpack textMessage
+                                    putMVar recvBuffer message
+                                    readIntoBuffer recvBuffer conn
                             
 handleCloseRequestException :: ConnectionException -> IO ()
 handleCloseRequestException (CloseRequest i reason) | i == 1000 = return ()