eventloop 0.8.2.2 → 0.8.2.3

raw patch · 4 files changed

+56/−18 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• eventloop.cabal +1/−1
• src/Eventloop/Module/BasicShapes/Classes.hs +18/−11
• src/Eventloop/Module/StatefulGraphics/StatefulGraphics.hs +1/−1
• src/Eventloop/Utility/Vectors.hs +36/−5

@@ -6,7 +6,7 @@ -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.8.2.2
+version:             0.8.2.3
 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),

@@ -8,7 +8,6 @@ import Eventloop.Module.BasicShapes.MeasureTextHack
 import qualified Eventloop.Module.Websocket.Canvas.Types as CT
 
-
 {-
 The center of a boundingbox is not the center of an element
     Rectangle - Intersection of two halves of adjoining sides
@@ -110,10 +109,24 @@ roundColor :: Color -> CT.ScreenColor
 roundColor (r, b, g, a) = (round r, round b, round g, a)
 
+strokePointsForLine :: StrokeLineThickness -> Point -> Point -> [Point]
+strokePointsForLine thick p1 p2
+    = [ followVector (0.5 * thick) upPerpVector p1
+      , followVector (0.5 * thick) upPerpVector p2
+      , followVector (0.5 * thick) downPerpVector p1
+      , followVector (0.5 * thick) downPerpVector p2
+      ]
 
+    where
+        upPerpVector = upPerpendicular p1 p2
+        downPerpVector = negateVector upPerpVector
+
 strokePointsForConnection :: StrokeLineThickness -> Point -> Point -> Point -> [Point]
 strokePointsForConnection strokeWidth start inspected dest
-    = [intersectVector sdown1 v1 sdown2 v2, intersectVector sup1 v1 sup2 v2]
+    | start == inspected && inspected == dest = [dest]
+    | start == inspected                      = strokePointsForLine strokeWidth inspected dest
+    | inspected == dest                       = strokePointsForLine strokeWidth start inspected
+    | otherwise                               = [p1, p2]
     where
         halfWidth = strokeWidth / 2
         quart = 0.5 * pi
@@ -129,6 +142,8 @@         sdown1 = followVector halfWidth downv1 inspected
         downv2 = negateVector upv2
         sdown2 = followVector halfWidth downv2 inspected
+        (Just p1) = intersectVector sdown1 v1 sdown2 v2
+        (Just p2) = intersectVector sup1 v1 sup2 v2
 
 
 strokePoints :: StrokeLineThickness -> [Point] -> [Point]
@@ -225,15 +240,7 @@             hheight = height * 0.5
 
     toPrimitives (Line {point1=p1, point2=p2, strokeLineThickness=thick, rotationM=Nothing})
-        = [ Points [ followVector (0.5 * thick) upPerpVector p1
-                   , followVector (0.5 * thick) upPerpVector p2
-                   , followVector (0.5 * thick) downPerpVector p1
-                   , followVector (0.5 * thick) downPerpVector p2
-                   ]
-          ]
-        where
-            upPerpVector = upPerpendicular p1 p2
-            downPerpVector = negateVector upPerpVector
+        = [Points (strokePointsForLine thick p1 p2)]
     toPrimitives (MultiLine {points=points, strokeLineThickness=thick, strokeColor=color, rotationM=Nothing})
         | len >= 3 = (Points strokePoints_) : (concat $ map toPrimitives lines)
         | len == 2 = toPrimitives (Line p1 p2 thick color Nothing)

@@ -104,7 +104,7 @@ calculateRemove :: StatefulBB                 -> ClearPart calculateRemove (StatefulBB _ bb)-    = ClearRectangle (floor $ xMin bb, floor $ yMin bb) (ceiling width + 1, ceiling height + 1)+    = ClearRectangle ((floor $ xMin bb) - 1, (floor $ yMin bb) - 1) (ceiling width + 2, ceiling height + 2)     where         height = (yMax bb) - (yMin bb)         width = (xMax bb) - (xMin bb)

@@ -101,12 +101,43 @@         size     = lengthBetweenPoints followP originPoint
 
 
-intersectVector :: Point -> Point -> Point -> Point -> Point
-intersectVector s1@(Point (s1x, s1y)) v1@(Point (v1x, v1y)) s2@(Point (s2x, s2y)) v2@(Point (v2x, v2y))
-    | v2y /= 0 = Point (v1x * lambda + s1x, v1y * lambda + s1y)
-    | otherwise = intersectVector s2 v2 s1 v1
+intersectVector :: Point -> Point -> Point -> Point -> Maybe Point
+intersectVector s1@(Point (sx1, sy1)) v1@(Point (vx1, vy1)) s2@(Point (sx2, sy2)) v2@(Point (vx2, vy2))
+    -- Optimization
+    | sx1 == sx2 && sy1 == sy2 = Just $ Point (sx1, sy1)
+
+    -- alpha relation exists
+    | alpha4_1_divisor /= 0 = Just $ Point(vx1 * alpha4_1 + sx1, vy1 * alpha4_1 + sy1)
+    -- 2 or more directions are empty in such a way alpha does not exist: (v2x == 0 || v1y == 0) && (v1x == 0 && v2y == 0)
+
+    -- 2 vector direction == zero
+    | vx1 == 0 && vy1 /= 0 && vx2 == 0 && vy2 /= 0     && sx1 == sx2 = Just $ Point (sx1, alpha_vy1_zero * vy2 + sy2) -- Do as if vy1 == 0 even if it isn't. We need to choose a point
+    | vx1 /= 0 && vy1 == 0 && vx2 /= 0 && vy2 == 0     && sy1 == sy2 = Just $ Point (alpha_vx1_zero * vx2 + sx2, sy1)
+
+    | vx1 == 0 && vy1 == 0 && vx2 /= 0 && vy2 /= 0     && alpha_vx1_zero == alpha_vy1_zero = Just $ Point (alpha_vx1_zero * vx2 + sx2, alpha_vy1_zero * vy2 + sy2)
+    | vx1 /= 0 && vy1 /= 0 && vx2 == 0 && vy2 == 0     && alpha_vx2_zero == alpha_vy2_zero = Just $ Point (alpha_vx2_zero * vx1 + sx1, alpha_vy2_zero * vy1 + sy1)
+
+    -- 3 vector direction == zero
+    | vx1 /= 0 && vy1 == 0 && vx2 == 0 && vy2 == 0    && sy1 == sy2 = Just $ Point (alpha_vx2_zero * vx1 + sx1, sy1)
+    | vx1 == 0 && vy1 /= 0 && vx2 == 0 && vy2 == 0    && sx1 == sx2 = Just $ Point (sx1, alpha_vy2_zero * vy1 + sy1)
+    | vx1 == 0 && vy1 == 0 && vx2 /= 0 && vy2 == 0    && sy1 == sy2 = Just $ Point (alpha_vx1_zero * vx2 + sx2, sy2)
+    | vx1 == 0 && vy1 == 0 && vx2 == 0 && vy2 /= 0    && sx1 == sx2 = Just $ Point (sx2, alpha_vy1_zero * vy2 + sy2)
+
+    -- 4 vector direction == zero
+    | vx1 == 0 && vy1 == 0 && vx2 == 0 && vy2 == 0    && s1 == s2 = Just $ s1
+
+    | otherwise = Nothing
     where
-        lambda = (s1x - s2x - (v2x * s1y) / v2y + (v2x * s2y) / v2y) / ((v2x * v1y) / v2y - v1x)
+        alpha4_1_divisor = vx2 * vy1 - vx1 * vy2
+        alpha4 (Point (dx1, dy1)) (Point (x1, y1)) (Point (dx2, dy2)) (Point (x2, y2)) = (dy2 * x1 - x2 * dy2 + dx2 * y2 - dx2 * y1) / (dx2 * dy1 - dx1 * dy2)
+        alpha4_1 = alpha4 v1 s1 v2 s2
+        alpha4_2 = alpha4 v2 s2 v1 s1
+
+        alphaZero dx1 x1 x2 = (x2 - x1) / dx1
+        alpha_vx1_zero = alphaZero vx2 sx2 sx1
+        alpha_vx2_zero = alphaZero vx1 sx1 sx2
+        alpha_vy1_zero = alphaZero vy2 sy2 sy1
+        alpha_vy2_zero = alphaZero vy1 sy1 sy2
 
 
 turnToVector :: Point -> Radians -> Point -> Point