From 8333d3d4f1ccd0f7e2732141fdc935fe92f1d2bb Mon Sep 17 00:00:00 2001 From: David Himmelstrup Date: Thu, 5 Dec 2019 17:17:22 +0800 Subject: [PATCH] Improve povray examples. Former-commit-id: b1101fe5b3a7b9bec0b6b92f303d42be8114d128 --- docs/gallery.md | 15 +++ docs/gen_gallery.sh | 3 +- docs/glue_tut.md | 31 ++++- examples/tut_glue_latex.hs | 8 +- examples/tut_glue_povray.hs | 149 +++++++++++++++++----- examples/tut_glue_povray_ortho.hs | 203 ++++++++++++++++++++++++++++++ 6 files changed, 370 insertions(+), 39 deletions(-) create mode 100755 examples/tut_glue_povray_ortho.hs diff --git a/docs/gallery.md b/docs/gallery.md index f5751db..fa2a5c8 100644 --- a/docs/gallery.md +++ b/docs/gallery.md @@ -241,3 +241,18 @@ This file is auto-generated by docs/render_all.sh. DO NOT EDIT.

+## tut_glue_povray + +
+ View tut_glue_povray.hs + 

+  {!examples/tut_glue_povray.hs!}
+
+
+
+ + +

+ diff --git a/docs/gen_gallery.sh b/docs/gen_gallery.sh index 2334403..afbd8fc 100755 --- a/docs/gen_gallery.sh +++ b/docs/gen_gallery.sh @@ -4,7 +4,8 @@ ROOT=`stack path --project-root` EXAMPLES='boundingbox colormaps goo latex_basic latex_color latex_draw latex_wheel raster sphere blender_default_cube tut_glue_svg tut_glue_animate tut_glue_keyframe tut_glue_fourier - tut_glue_physics tut_glue_latex' + tut_glue_physics tut_glue_latex tut_glue_povray + tut_glue_povray_ortho' WIDTH=640 HEIGHT=$((WIDTH*9/16)) diff --git a/docs/glue_tut.md b/docs/glue_tut.md index fea979a..f7aa86e 100644 --- a/docs/glue_tut.md +++ b/docs/glue_tut.md @@ -82,7 +82,7 @@ The following examples shows how something as seemingly complicated as fourier s -Scripting in Haskell also gives access to the extensive body of code libraries. There are Haskell libraries for syntax highlighting, font manipulation, and much, much more. In the spirit of being a batteries-included framework, Reanimate ships with a built-in 2D physics library, called Chipmunk2D. The example below demonstrates how SVG shapes can be generated with LaTeX and then nearly effortlessly used in a physics simulation. +Scripting in Haskell also gives access to the extensive body of code libraries. There are Haskell libraries for syntax highlighting, font manipulation, and much, much more. In the spirit of being a batteries-included framework, Reanimate ships with a built-in 2D physics library, called Chipmunk2D. The example below demonstrates how SVG shapes can be used nearly effortlessly in a physics simulation.
Toggle source code. @@ -120,7 +120,34 @@ The resulting SVGs can be manipulated just like any other. The below examples il ## Pillar III: povray -TODO: Draw text and animate shapes, zoom out so it looks like a piece of paper (still animated), draw circle, fade in rotating sphere. +TODO: Draw text and animate shapes, zoom out so it looks like a piece of paper (still animated). + +
+ Toggle source code. + 

+  {!examples/tut_glue_povray.hs!}
+
+
+
+ + +TODO: Talk about orthographic projection. Draw circle, fade in rotating sphere. + +
+ Toggle source code. + 

+  {!examples/tut_glue_povray_ortho.hs!}
+
+
+
+ + ## Pillar IV: Blender diff --git a/examples/tut_glue_latex.hs b/examples/tut_glue_latex.hs index ef6fb28..0c7b072 100755 --- a/examples/tut_glue_latex.hs +++ b/examples/tut_glue_latex.hs @@ -16,7 +16,12 @@ import System.Random import System.Random.Shuffle main :: IO () -main = reanimate $ parA bg $ sceneAnimation $ do +main = reanimate $ parA bg latexExample + where + bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF) + +latexExample :: Animation +latexExample = sceneAnimation $ do -- Draw equation play $ drawAnimation strokedSvg sprites <- forM glyphs $ \(fn, _, elt) -> @@ -41,7 +46,6 @@ main = reanimate $ parA bg $ sceneAnimation $ do withStrokeColor "black" svg svg = lowerTransformations $ simplify $ scale 2 $ center $ latexAlign "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}" - bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF) shuffleList lst = shuffle' lst (length lst) (mkStdGen 0xdeadbeef) highlightE :: Effect diff --git a/examples/tut_glue_povray.hs b/examples/tut_glue_povray.hs index a6edbe5..683befe 100755 --- a/examples/tut_glue_povray.hs +++ b/examples/tut_glue_povray.hs @@ -5,80 +5,83 @@ module Main (main) where import Reanimate +import Reanimate.Scene +import Reanimate.Animation import Reanimate.Povray import Reanimate.Raster +import Reanimate.Effect import Data.String.Here +import Graphics.SvgTree hiding (Text) import Data.Text (Text) +import Codec.Picture +import System.Random +import System.Random.Shuffle +import Control.Lens ((^.)) +import Data.Monoid +import Control.Monad +import Codec.Picture.Types + main :: IO () -main = reanimate $ mkAnimation 10 $ \t -> - let s = fromToS 0 4 t in - let rot = fromToS 0 (360) t in - mkGroup - [ mkBackground "black" - , povraySlow [] (script (svgAsPngFile (texture $ oscillateS t)) s rot) - -- , texture $ oscillateS t - ] +main = reanimate $ parA bg $ sceneAnimation $ do + zPos <- newVar 0 + xRot <- newVar 0 + zRot <- newVar 0 + s <- newSprite $ do + transZ <- freezeVar zPos + getX <- freezeVar xRot + getZ <- freezeVar zRot + return $ \real_t dur t -> + povraySlow [] $ + script (svgAsPngFile (texture (t/dur))) (transZ real_t) (getX real_t) (getZ real_t) + wait 2 + tweenVar zPos 9 (\t v -> fromToS v 8 (t/9)) + tweenVar xRot 9 (\t v -> fromToS v 360 $ curveS 2 (t/9)) + tweenVar zRot 9 (\t v -> fromToS v 360 $ curveS 2 (t/9)) + wait 10 + tweenVar zPos 2 (\t v -> fromToS v 0 $ curveS 3 (t/2)) + wait 2 where + bg = animate $ const $ mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF texture :: Double -> SVG texture t = mkGroup [ checker 10 10 - , translate (screenWidth/2) 0 $ - translate (-screenWidth*t) 0 $ - withFillColor "red" $ mkCircle 3 ] + , frameAt (t*duration latexExample) latexExample ] -script :: FilePath -> Double -> Double -> Text -script png s rot = [iTrim| -//EXAMPLE OF SPHERE - -//Files with predefined colors and textures +script :: FilePath -> Double -> Double -> Double -> Text +script png transZ rotX rotZ = [iTrim| #include "colors.inc" -#include "glass.inc" -#include "golds.inc" -#include "metals.inc" -#include "stones.inc" -#include "woods.inc" - -#include "shapes3.inc" //Place the camera camera { perspective - //location <0,0,-9-${s*2}> location <0,0,-9> look_at <0,0,0> up y right x*16/9 } - - //Ambient light to "brighten up" darker pictures global_settings { ambient_light White*3 } //Set a background color -//background { color White } -//background { color rgbt <0.1, 0, 0, 0> } // red background { color rgbt <0, 0, 0, 1> } // transparent polygon { 4, - //<-9, -4.5>, <-9, 4.5>, <9, 4.5>, <9, -4.5> <0, 0>, <0, 1>, <1, 1>, <1, 0> texture { - //pigment{ color rgb <0,1,0> } pigment{ image_map{ png ${png} } } } translate <-1/2,-1/2> scale <16,9> - rotate <0,${rot},${rot}> - translate <0,0,${s*2}> + rotate <0,${rotX},${rotZ}> + translate <0,0,${transZ}> } - - |] +|] checker :: Int -> Int -> SVG checker w h = @@ -105,3 +108,81 @@ checker w h = stepY = screenHeight/fromIntegral h offsetX = screenWidth/2 offsetY = screenHeight/2 + + +----------------------------------- +-- COPIED FROM tut_glue_latex.hs -- + + + +latexExample :: Animation +latexExample = sceneAnimation $ do + -- Draw equation + play $ drawAnimation strokedSvg + sprites <- forM glyphs $ \(fn, _, elt) -> + newSpriteA $ animate $ const $ fn elt + -- Yoink each glyph + forM_ (reverse sprites) $ \sprite -> do + spriteE sprite (overBeginning 1 $ aroundCenterE $ highlightE) + wait 0.5 + -- Flash glyphs randomly with color + forM_ (shuffleList (sprites++sprites)) $ \sprite -> do + spriteE sprite (overBeginning 0.5 $ aroundCenterE $ flashE) + wait 0.1 + wait 0.5 + mapM_ destroySprite sprites + -- Undraw equations + play $ drawAnimation' (Just 0xdeadbeef) 1 0.1 strokedSvg + # reverseA + where + glyphs = svgGlyphs svg + strokedSvg = + withStrokeWidth (defaultStrokeWidth*0.5) $ + withStrokeColor "black" svg + svg = lowerTransformations $ simplify $ scale 2 $ center $ + latexAlign "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}" + shuffleList lst = shuffle' lst (length lst) (mkStdGen 0xdeadbeef) + +highlightE :: Effect +highlightE d t = + scale (1 + bellS 2 (t/d)*0.5) . rotate (wiggleS (t/d) * 20) + +flashE :: Effect +flashE d t = + withStrokeColor "black" . + withStrokeWidth (defaultStrokeWidth*0.5*bellS 2 (t/d)) . + withFillColorPixel (promotePixel $ turbo (t/d)) + +-- s-curve, sin, s-curve +wiggleS :: Signal +wiggleS t + | t < 0.25 = curveS 2 (t*4) + | t < 0.75 = sin ((t-0.25)*2*pi+pi/2) + | otherwise = curveS 2 ((t-0.75)*4)-1 + +-- + +drawAnimation :: SVG -> Animation +drawAnimation = drawAnimation' Nothing 0.5 0.3 + +drawAnimation' :: Maybe Int -> Double -> Double -> SVG -> Animation +drawAnimation' mbSeed fillDur step svg = sceneAnimation $ do + forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do + let sWidth = + case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of + Just (Num d) -> d + _ -> defaultStrokeWidth + fork $ do + wait (n*step) + play $ mapA fn $ (animate (\t -> withFillOpacity 0 $ partialSvg t tree) + # applyE (overEnding fillDur $ fadeLineOutE sWidth)) + fork $ do + wait (n*step+(1-fillDur)) + newSprite $ do + return $ \_real_t _d t -> + withStrokeWidth 0 $ fn $ withFillOpacity (min 1 $ t/fillDur) tree + where + shuf lst = + case mbSeed of + Nothing -> lst + Just seed -> shuffle' lst (length lst) (mkStdGen seed) diff --git a/examples/tut_glue_povray_ortho.hs b/examples/tut_glue_povray_ortho.hs new file mode 100755 index 0000000..2fbaf9c --- /dev/null +++ b/examples/tut_glue_povray_ortho.hs @@ -0,0 +1,203 @@ +#!/usr/bin/env stack +-- stack runghc --package reanimate +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module Main (main) where + +import Reanimate +import Reanimate.Scene +import Reanimate.Animation +import Reanimate.Povray +import Reanimate.Raster +import Data.String.Here +import Data.Text (Text) +import Codec.Picture +import Reanimate.Effect +import Reanimate.Scene +import System.Random +import System.Random.Shuffle +import Graphics.SvgTree hiding (Text) +import Control.Lens ((^.)) +import Control.Monad +import Codec.Picture.Types +import Data.Monoid + + +main :: IO () +main = reanimate $ parA bg $ sceneAnimation $ do + xRot <- newVar (-30) + yRot <- newVar 180 + zRot <- newVar 0 + s <- newSprite $ do + getX <- freezeVar xRot + getY <- freezeVar yRot + getZ <- freezeVar zRot + return $ \real_t dur t -> + povraySlow [] $ + script (svgAsPngFile (texture (t/dur))) (getX real_t) (getY real_t) (getZ real_t) + wait 2 + let tDuration = 20 + tweenVar yRot tDuration (\t v -> fromToS v (v+180) $ curveS 2 (t/tDuration)) + tweenVar xRot (tDuration/2) (\t v -> fromToS v (v+60) $ curveS 2 (t/(tDuration/2))) + fork $ do + wait (tDuration/2) + tweenVar xRot (tDuration/2) (\t v -> fromToS v (v-60) $ curveS 2 (t/(tDuration/2))) + --tweenVar zRot 9 (\t v -> fromToS v 360 $ curveS 2 (t/9)) + wait tDuration + wait 2 + --tweenVar zPos 2 (\t v -> fromToS v 0 $ curveS 3 (t/2)) + --wait 2 + where + bg = animate $ const $ mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF + +texture :: Double -> SVG +texture t = mkGroup + [ checker 10 10 + , frameAt (t*duration latexExample) latexExample + ] + +script :: FilePath -> Double -> Double -> Double -> Text +script png rotX rotY rotZ = [iTrim| +//Files with predefined colors and textures +#include "colors.inc" + +#include "shapes3.inc" + +//Place the camera +camera { + orthographic + location <0,0,-10> + look_at <0,0,0> + up <0,9,0> + right <16,0,0> +} + + +//Ambient light to "brighten up" darker pictures +global_settings { ambient_light White*3 } + +//Set a background color +//background { color White } +//background { color rgbt <0.1, 0, 0, 0> } // red +background { color rgbt <0, 0, 0, 1> } // transparent + +//Sphere with specified center point and radius +sphere { + <0,0,0>, 4 + texture { + uv_mapping pigment{ + image_map{ png ${png} } + } + } + rotate <0,${rotY},${rotZ}> + rotate <${rotX},0,0> +} + +|] + +checker :: Int -> Int -> SVG +checker w h = + withFillColor "white" $ + withStrokeColor "white" $ + withStrokeWidth 0.1 $ + mkGroup + [ withStrokeWidth 0 $ + withFillOpacity 0.7 $ mkBackground "blue" + , mkGroup + [ translate (stepX*x-offsetX + stepX/2) 0 $ + mkLine (0, -screenHeight/2*0.9) (0, screenHeight/2*0.9) + | x <- map fromIntegral [0..w-1] + ] + , + mkGroup + [ translate 0 (stepY*y-offsetY) $ + mkLine (-screenWidth/2, 0) (screenWidth/2, 0) + | y <- map fromIntegral [0..h] + ] + ] + where + stepX = screenWidth/fromIntegral w + stepY = screenHeight/fromIntegral h + offsetX = screenWidth/2 + offsetY = screenHeight/2 + + + + +----------------------------------- +-- COPIED FROM tut_glue_latex.hs -- + + +latexExample :: Animation +latexExample = sceneAnimation $ do + -- Draw equation + play $ drawAnimation strokedSvg + sprites <- forM glyphs $ \(fn, _, elt) -> + newSpriteA $ animate $ const $ fn elt + -- Yoink each glyph + forM_ (reverse sprites) $ \sprite -> do + spriteE sprite (overBeginning 1 $ aroundCenterE $ highlightE) + wait 0.5 + -- Flash glyphs randomly with color + forM_ (shuffleList (sprites++sprites)) $ \sprite -> do + spriteE sprite (overBeginning 0.5 $ aroundCenterE $ flashE) + wait 0.1 + wait 0.5 + mapM_ destroySprite sprites + -- Undraw equations + play $ drawAnimation' (Just 0xdeadbeef) 1 0.1 strokedSvg + # reverseA + where + glyphs = svgGlyphs svg + strokedSvg = + withStrokeWidth (defaultStrokeWidth*0.5) $ + withStrokeColor "black" svg + svg = lowerTransformations $ simplify $ scale 2 $ center $ + latexAlign "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}" + bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF) + shuffleList lst = shuffle' lst (length lst) (mkStdGen 0xdeadbeef) + +highlightE :: Effect +highlightE d t = + scale (1 + bellS 2 (t/d)*0.5) . rotate (wiggleS (t/d) * 20) + +flashE :: Effect +flashE d t = + withStrokeColor "black" . + withStrokeWidth (defaultStrokeWidth*0.5*bellS 2 (t/d)) . + withFillColorPixel (promotePixel $ turbo (t/d)) + +-- s-curve, sin, s-curve +wiggleS :: Signal +wiggleS t + | t < 0.25 = curveS 2 (t*4) + | t < 0.75 = sin ((t-0.25)*2*pi+pi/2) + | otherwise = curveS 2 ((t-0.75)*4)-1 + +-- + +drawAnimation :: SVG -> Animation +drawAnimation = drawAnimation' Nothing 0.5 0.3 + +drawAnimation' :: Maybe Int -> Double -> Double -> SVG -> Animation +drawAnimation' mbSeed fillDur step svg = sceneAnimation $ do + forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do + let sWidth = + case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of + Just (Num d) -> d + _ -> defaultStrokeWidth + fork $ do + wait (n*step) + play $ mapA fn $ (animate (\t -> withFillOpacity 0 $ partialSvg t tree) + # applyE (overEnding fillDur $ fadeLineOutE sWidth)) + fork $ do + wait (n*step+(1-fillDur)) + newSprite $ do + return $ \_real_t _d t -> + withStrokeWidth 0 $ fn $ withFillOpacity (min 1 $ t/fillDur) tree + where + shuf lst = + case mbSeed of + Nothing -> lst + Just seed -> shuffle' lst (length lst) (mkStdGen seed) +