diff --git a/eventloop.cabal b/eventloop.cabal --- a/eventloop.cabal +++ b/eventloop.cabal @@ -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), diff --git a/src/Eventloop/Module/BasicShapes/Classes.hs b/src/Eventloop/Module/BasicShapes/Classes.hs --- a/src/Eventloop/Module/BasicShapes/Classes.hs +++ b/src/Eventloop/Module/BasicShapes/Classes.hs @@ -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) diff --git a/src/Eventloop/Module/StatefulGraphics/StatefulGraphics.hs b/src/Eventloop/Module/StatefulGraphics/StatefulGraphics.hs --- a/src/Eventloop/Module/StatefulGraphics/StatefulGraphics.hs +++ b/src/Eventloop/Module/StatefulGraphics/StatefulGraphics.hs @@ -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) diff --git a/src/Eventloop/Utility/Vectors.hs b/src/Eventloop/Utility/Vectors.hs --- a/src/Eventloop/Utility/Vectors.hs +++ b/src/Eventloop/Utility/Vectors.hs @@ -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