mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-12 00:23:08 +00:00
Fix fragile docker builds. (#163)
This commit is contained in:
parent
29d173850a
commit
9ddfbde124
3 changed files with 170 additions and 151 deletions
|
|
@ -20,7 +20,10 @@ WORKDIR /src
|
|||
|
||||
# Install reanimate dependencies and cache the layer
|
||||
ADD reanimate.cabal stack.yaml ./
|
||||
RUN stack build --only-dependencies --no-install-ghc --system-ghc --haddock
|
||||
RUN for i in 1 2 3; \
|
||||
do \
|
||||
stack build --only-dependencies --no-install-ghc --system-ghc --haddock && break; \
|
||||
done
|
||||
|
||||
# Install discord-bot dependencies and cache the layer
|
||||
ADD discord-bot/discord-bot.cabal discord-bot/stack.yaml ./discord-bot/
|
||||
|
|
|
|||
|
|
@ -20,7 +20,10 @@ WORKDIR /src
|
|||
|
||||
# Install reanimate dependencies and cache the layer
|
||||
ADD reanimate.cabal stack.yaml ./
|
||||
RUN stack build --only-dependencies --no-install-ghc --system-ghc --haddock
|
||||
RUN for i in 1 2 3; \
|
||||
do \
|
||||
stack build --only-dependencies --no-install-ghc --system-ghc --haddock && break; \
|
||||
done
|
||||
|
||||
# Install discord-bot dependencies and cache the layer
|
||||
ADD playground/playground.cabal playground/stack.yaml ./playground/
|
||||
|
|
|
|||
|
|
@ -1,24 +1,25 @@
|
|||
{-|
|
||||
Copyright : Written by David Himmelstrup
|
||||
License : Unlicense
|
||||
Maintainer : lemmih@gmail.com
|
||||
Stability : experimental
|
||||
Portability : POSIX
|
||||
-}
|
||||
-- |
|
||||
-- Copyright : Written by David Himmelstrup
|
||||
-- License : Unlicense
|
||||
-- Maintainer : lemmih@gmail.com
|
||||
-- Stability : experimental
|
||||
-- Portability : POSIX
|
||||
module Reanimate.Svg.LineCommand
|
||||
( CmdM
|
||||
, LineCommand(..)
|
||||
, lineLength
|
||||
, toLineCommands
|
||||
, lineToPath
|
||||
, lineToPoints
|
||||
, partialSvg
|
||||
) where
|
||||
( CmdM,
|
||||
LineCommand (..),
|
||||
lineLength,
|
||||
toLineCommands,
|
||||
lineToPath,
|
||||
lineToPoints,
|
||||
partialSvg,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Lens ((%~), (&), (.~))
|
||||
import Control.Monad.Fix
|
||||
import Control.Monad.State
|
||||
import Data.Functor
|
||||
import Data.Maybe
|
||||
import qualified Data.Vector.Unboxed as V
|
||||
import qualified Geom2D.CubicBezier.Linear as Bezier
|
||||
import Graphics.SvgTree
|
||||
|
|
@ -32,8 +33,8 @@ type CmdM a = State RPoint a
|
|||
-- | Simplified version of a PathCommand where all points are absolute.
|
||||
data LineCommand
|
||||
= LineMove RPoint
|
||||
-- | LineDraw RPoint
|
||||
| LineBezier [RPoint]
|
||||
| -- | LineDraw RPoint
|
||||
LineBezier [RPoint]
|
||||
| LineEnd RPoint
|
||||
deriving (Show)
|
||||
|
||||
|
|
@ -52,12 +53,12 @@ lineToPath = map worker
|
|||
-- | Using @n@ control points, approximate the path of the curves.
|
||||
lineToPoints :: Int -> [LineCommand] -> [RPoint]
|
||||
lineToPoints nPoints cmds =
|
||||
map lineEnd lineSegments
|
||||
mapMaybe lineEnd lineSegments
|
||||
where
|
||||
lineSegments = [partialLine (fromIntegral n / fromIntegral nPoints) cmds | n <- [0 .. nPoints -1]]
|
||||
lineEnd [LineBezier pts] = last pts
|
||||
lineEnd [] = Nothing
|
||||
lineEnd [LineBezier pts] = Just (last pts)
|
||||
lineEnd (_ : xs) = lineEnd xs
|
||||
lineEnd _ = error "invalid line"
|
||||
|
||||
partialLine :: Double -> [LineCommand] -> [LineCommand]
|
||||
partialLine alpha cmds = evalState (worker 0 cmds) zero
|
||||
|
|
@ -165,10 +166,14 @@ toLineCommand startPos mbPrevControlPt cmd =
|
|||
from <- get <* adjustPosition o to
|
||||
let c1 = maybe from (mirrorPoint from) mbControl
|
||||
pure $ LineBezier [c1, makeAbsolute o from to]
|
||||
EllipticalArc o points -> concat <$>
|
||||
forM points (\(rotX, rotY, angle, largeArc, sweepFlag, to) -> do
|
||||
EllipticalArc o points ->
|
||||
concat
|
||||
<$> forM
|
||||
points
|
||||
( \(rotX, rotY, angle, largeArc, sweepFlag, to) -> do
|
||||
from <- get <* adjustPosition o to
|
||||
return $ convertSvgArc from rotX rotY angle largeArc sweepFlag (makeAbsolute o from to))
|
||||
return $ convertSvgArc from rotX rotY angle largeArc sweepFlag (makeAbsolute o from to)
|
||||
)
|
||||
EndPath -> put startPos $> [LineEnd startPos]
|
||||
where
|
||||
mirrorPoint c p = c * 2 - p
|
||||
|
|
@ -177,13 +182,12 @@ toLineCommand startPos mbPrevControlPt cmd =
|
|||
makeAbsolute OriginAbsolute _from p = p
|
||||
makeAbsolute OriginRelative from p = from + p
|
||||
|
||||
|
||||
calculateVectorAngle :: Double -> Double -> Double -> Double -> Double
|
||||
calculateVectorAngle ux uy vx vy
|
||||
| tb >= ta
|
||||
= tb - ta
|
||||
| otherwise
|
||||
= pi * 2 - (ta - tb)
|
||||
| tb >= ta =
|
||||
tb - ta
|
||||
| otherwise =
|
||||
pi * 2 - (ta - tb)
|
||||
where
|
||||
ta = atan2 uy ux
|
||||
tb = atan2 vy vx
|
||||
|
|
@ -192,12 +196,12 @@ calculateVectorAngle ux uy vx vy
|
|||
{- HLINT ignore convertSvgArc -}
|
||||
convertSvgArc :: RPoint -> Coord -> Coord -> Coord -> Bool -> Bool -> RPoint -> [LineCommand]
|
||||
convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)
|
||||
| x0 == x && y0 == y
|
||||
= []
|
||||
| radiusX == 0.0 && radiusY == 0.0
|
||||
= [LineBezier [V2 x y]]
|
||||
| otherwise
|
||||
= calcSegments x0 y0 theta1' segments'
|
||||
| x0 == x && y0 == y =
|
||||
[]
|
||||
| radiusX == 0.0 && radiusY == 0.0 =
|
||||
[LineBezier [V2 x y]]
|
||||
| otherwise =
|
||||
calcSegments x0 y0 theta1' segments'
|
||||
where
|
||||
sinPhi = sin (angle * pi / 180)
|
||||
cosPhi = cos (angle * pi / 180)
|
||||
|
|
@ -210,10 +214,13 @@ convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)
|
|||
s = sqrt (1.0 - numerator / (radiusX * radiusX * radiusY * radiusY))
|
||||
rx = if (numerator < 0.0) then (radiusX * s) else radiusX
|
||||
ry = if (numerator < 0.0) then (radiusY * s) else radiusY
|
||||
root = if (numerator < 0.0)
|
||||
root =
|
||||
if (numerator < 0.0)
|
||||
then (0.0)
|
||||
else ((if ((largeArcFlag && sweepFlag) || (not largeArcFlag && not sweepFlag)) then (-1.0) else 1.0) *
|
||||
sqrt(numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash)))
|
||||
else
|
||||
( (if ((largeArcFlag && sweepFlag) || (not largeArcFlag && not sweepFlag)) then (-1.0) else 1.0)
|
||||
* sqrt (numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash))
|
||||
)
|
||||
|
||||
cxdash = root * rx * y1dash / ry
|
||||
cydash = - root * ry * x1dash / rx
|
||||
|
|
@ -223,7 +230,8 @@ convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)
|
|||
|
||||
theta1' = calculateVectorAngle 1.0 0.0 ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry)
|
||||
dtheta' = calculateVectorAngle ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry) ((- x1dash - cxdash) / rx) ((- y1dash - cydash) / ry)
|
||||
dtheta = if (not sweepFlag && dtheta' > 0)
|
||||
dtheta =
|
||||
if (not sweepFlag && dtheta' > 0)
|
||||
then (dtheta' - 2 * pi)
|
||||
else (if (sweepFlag && dtheta' < 0) then dtheta' + 2 * pi else dtheta')
|
||||
|
||||
|
|
@ -232,12 +240,15 @@ convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)
|
|||
t = 8.0 / 3.0 * sin (delta / 4.0) * sin (delta / 4.0) / sin (delta / 2.0)
|
||||
|
||||
calcSegments startX startY theta1 segments
|
||||
| segments == 0
|
||||
= []
|
||||
| otherwise
|
||||
= LineBezier [ V2 (startX + dx1) (startY + dy1)
|
||||
, V2 (endpointX + dxe) (endpointY + dye)
|
||||
, V2 endpointX endpointY ] : calcSegments endpointX endpointY theta2 (segments - 1)
|
||||
| segments == 0 =
|
||||
[]
|
||||
| otherwise =
|
||||
LineBezier
|
||||
[ V2 (startX + dx1) (startY + dy1),
|
||||
V2 (endpointX + dxe) (endpointY + dye),
|
||||
V2 endpointX endpointY
|
||||
] :
|
||||
calcSegments endpointX endpointY theta2 (segments - 1)
|
||||
where
|
||||
cosTheta1 = cos theta1
|
||||
sinTheta1 = sin theta1
|
||||
|
|
@ -260,17 +271,19 @@ partialBezierPoints ps a b =
|
|||
Bezier.AnyBezier os = Bezier.bezierSubsegment c1 a b
|
||||
in V.toList os
|
||||
|
||||
{- | Create an image showing portion of a path.
|
||||
Note that this only affects paths (see 'Reanimate.Svg.Constructors.mkPath').
|
||||
You can also use this with other SVG shapes if you convert them to path first (see 'Reanimate.Svg.pathify').
|
||||
|
||||
Typical usage:
|
||||
|
||||
> animate $ \t -> partialSvg t myPath
|
||||
-}
|
||||
partialSvg :: Double -- ^ number between 0 and 1 inclusively, determining what portion of the path to show
|
||||
-> Tree -- ^ Image representing a path, of which we only want to display a portion determined by the first argument
|
||||
-> Tree
|
||||
-- | Create an image showing portion of a path.
|
||||
-- Note that this only affects paths (see 'Reanimate.Svg.Constructors.mkPath').
|
||||
-- You can also use this with other SVG shapes if you convert them to path first (see 'Reanimate.Svg.pathify').
|
||||
--
|
||||
-- Typical usage:
|
||||
--
|
||||
-- > animate $ \t -> partialSvg t myPath
|
||||
partialSvg ::
|
||||
-- | number between 0 and 1 inclusively, determining what portion of the path to show
|
||||
Double ->
|
||||
-- | Image representing a path, of which we only want to display a portion determined by the first argument
|
||||
Tree ->
|
||||
Tree
|
||||
partialSvg alpha | alpha >= 1 = id
|
||||
partialSvg alpha = mapTree worker
|
||||
where
|
||||
|
|
|
|||
Loading…
Reference in a new issue