reanimate 0.3.2.0 → 0.3.2.1
raw patch · 2 files changed
+57/−72 lines, 2 files
Files
- examples/voice_transcript.hs +55/−70
- reanimate.cabal +2/−2
examples/voice_transcript.hs view
@@ -86,8 +86,9 @@ transcript :: Transcript transcript = fakeTranscript- "Testing transcript.\n\n\- \Second paragraph"+ "This is a fake transcript.\n\n\n\+ \No audio has been recorded\n\n\+ \and the timings are guessed." data Token = TokenWord Int Int T.Text | TokenComma | TokenPeriod | TokenParagraph deriving (Show)@@ -99,10 +100,10 @@ Nothing -> [] Just (c, cs) | isSpace c- -> let (w, rest) = T.span (=='\n') txt in- if T.length w >= 2- then TokenParagraph : worker (offset + T.length w) rest- else worker (offset+1) cs+ -> let (w, rest) = T.span (== '\n') txt+ in if T.length w >= 3+ then TokenParagraph : worker (offset + T.length w) rest+ else worker (offset + 1) cs | c == '.' -> TokenPeriod : worker (offset + 1) cs | c == ','@@ -122,24 +123,24 @@ worker now [] = [] worker now (token : rest) = case token of TokenWord start end w ->- let duration = 60 / wpm+ let duration = realToFrac (end-start) * 0.1 in TWord { wordAligned = T.toLower w , wordCase = "success" , wordStart = now- , wordStartOffset = 0+ , wordStartOffset = start , wordEnd = now + duration- , wordEndOffset = 0+ , wordEndOffset = end , wordPhones = [] , wordReference = w } : worker (now + duration) rest- TokenComma -> worker (now + commaPause) rest- TokenPeriod -> worker (now + periodPause) rest+ TokenComma -> worker (now + commaPause) rest+ TokenPeriod -> worker (now + periodPause) rest TokenParagraph -> worker (now + paragraphPause) rest wpm = 130- paragraphPause = 0.1- commaPause = 0.05- periodPause = 0.05+ paragraphPause = 0.5+ commaPause = 0.1+ periodPause = 0.2 -- tweenVar :: Var s a -> Duration -> (a -> Time -> a) -> Scene s () -- interpolateRGBA8 :: ColorComponents -> PixelRGBA8 -> PixelRGBA8 -> (Double -> PixelRGBA8)@@ -150,73 +151,57 @@ main :: IO () main = reanimate $ sceneAnimation $ do newSpriteSVG_ $ mkBackground "black"- let maskSVG =- simplify $ withStrokeWidth 0 $ lowerTransformations $ center $ latex "Masked"- -- newSpriteSVG $ maskSVG- -- newSpriteA $ animate $ \t -> mkGroup- -- [ maskedIn t maskSVG (withFillColor "blue" $ mkRect (svgWidth maskSVG) screenHeight)- -- , maskedOut t maskSVG (withFillColor "white" $ mkRect (svgWidth maskSVG) screenHeight)- -- ]- newSpriteSVG $ withFillColor "grey" $ scale 0.8 $ center $ latex $ transcriptText- transcript-- -- wait 10- -- _ <- newSpriteSVG $ withStrokeWidth (defaultStrokeWidth*0.5) $- -- withStrokeColor "white" $ mkLine (-screenWidth, 0) (screenWidth, 0)- -- _ <- newSpriteSVG $ withStrokeWidth (defaultStrokeWidth*0.5) $- -- withStrokeColor "white" $ mkLine (0, -screenHeight) (0,screenHeight)- cOpacity <- newVar 0- cFill <- newVar $ toColor "black"- let- pushFill newColor = do- prevColor <- readVar cFill- tweenVar cFill 0.2- $ \p t -> if t > 0- then interpolateRGBA8 labComponents prevColor (toColor newColor) t- else p- c <- newSprite $ do- o <- unVar cOpacity- f <- unVar cFill- pure- $ withGroupOpacity o- $ withStrokeColor "white"- $ withFillColorPixel f- $ translate 4 0- $ mkCircle 1- txtVar <- newVar (mkGroup [])- t <- newSprite $ do- screenText <- unVar txtVar- pure $ withFillColor "white" $ screenText- -- waitOn $ forM_ (transcriptWords transcript) $ \TWord {..} ->- -- fork $ when (wordCase == "success") $ do- -- wait (wordStart - 0.1)- -- when (wordReference == "circle") $ do- -- wait (-0.1)- -- tweenVar cOpacity 0.2 $ \v -> fromToS v 1- -- when (wordReference == "red") $ pushFill "red"- -- when (wordReference == "green") $ pushFill "green"- -- when (wordReference == "blue") $ pushFill "blue"- -- when (wordReference == "Cyan") $ pushFill "cyan"- -- when (wordReference == "Purple") $ pushFill "purple"- -- when (wordReference == "White") $ pushFill "white"- -- writeVar txtVar $ alignText $ forceLayout wordReference- wait 3- return ()+ waitOn $ forM_ (transcriptGlyphs transcript) $ \(svg, tword) -> do+ highlighted <- newVar 0+ s <- newSprite $ do+ v <- unVar highlighted+ pure $ translate (-2) 2 $ scale 0.5 $ mkGroup+ [ maskedIn v svg (withFillColor "white" $ mkRect (svgWidth svg) screenHeight)+ , maskedOut v svg (withFillColor "grey" $ mkRect (svgWidth svg) screenHeight)+ ]+ fork $ do+ wait (wordStart tword)+ let dur = wordEnd tword - wordStart tword+ tweenVar highlighted dur $ \v -> fromToS v 1+ wait 2 maskedIn :: Double -> SVG -> SVG -> SVG maskedIn t maskSVG targetSVG = mkGroup [ mkClipPath label $ removeGroups maskSVG- , withClipPathRef (Ref label) $ translate (-svgWidth maskSVG * (1 - t)) 0 targetSVG+ , withClipPathRef (Ref label) $ translate (x-w/2 + w * t) y targetSVG ]- where label = "word-mask-" ++ show (hash $ renderTree maskSVG)+ where+ label = "word-mask-" ++ show (hash $ renderTree maskSVG)+ (x, y, w, _h) = boundingBox maskSVG maskedOut :: Double -> SVG -> SVG -> SVG maskedOut t maskSVG targetSVG = mkGroup [ mkClipPath label $ removeGroups maskSVG- , withClipPathRef (Ref label) $ translate (svgWidth maskSVG * t) 0 targetSVG+ , withClipPathRef (Ref label) $ translate (x+w/2 + w * t) y targetSVG ]- where label = "word-mask-" ++ show (hash $ renderTree maskSVG)+ where+ label = "word-mask-" ++ show (hash (renderTree maskSVG, renderTree targetSVG))+ (x, y, w, _h) = boundingBox maskSVG +-- svgGlyphs :: Tree -> [(Tree -> Tree, DrawAttributes, Tree)]+transcriptGlyphs :: Transcript -> [(SVG, TWord)]+transcriptGlyphs Transcript {..}+ | T.length textSymbols /= length gls+ = error "Bad size"+ | otherwise+ = [ ( mkGroup $ take (wordEndOffset - wordStartOffset) $ drop+ (wordStartOffset - spaces)+ gls+ , tword+ )+ | tword@TWord {..} <- transcriptWords+ , let spaces = nSpaces wordStartOffset+ ]+ where+ nSpaces limit = T.length (T.filter isSpace (T.take limit transcriptText))+ textSymbols = T.filter (not . isSpace) transcriptText+ total = center $ simplify $ latex transcriptText+ gls = [ ctx g | (ctx, _attr, g) <- svgGlyphs total ] forceLayout txt = fst $ splitGlyphs [0, 1, 2, 3] (latex $ "\\fbox{\\phantom{TyhILW}}" <> txt)
reanimate.cabal view
@@ -3,7 +3,7 @@ -- see http://haskell.org/cabal/users-guide/ name: reanimate-version: 0.3.2.0+version: 0.3.2.1 -- synopsis: -- description: license: PublicDomain@@ -38,7 +38,7 @@ Flag hmatrix Description: Enable hmatrix dependency (requires blas and lapack)- Default: True+ Default: False Manual: True Flag test