reanimate-0.2.0.0: examples/polyshape_test1.hs

#!/usr/bin/env stack
-- stack runghc --package reanimate
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

import           Control.Lens        ()
import           Data.List
import qualified Geom2D.CubicBezier  as G
import           Reanimate
import           Reanimate.PolyShape


polygonTest :: Animation
polygonTest = animate $ \_ ->
    std $ gridLayout $ transpose
      [ test0, test1, test2, test3, test4, test5 ]
  where
    test0 = column ppA poly1
    test1 = column ppA poly2
    test2 = column ppA poly3
    test3 = column ppA poly4
    test4 = column ppB [boxPolyShape]
    test5 = column ppB [starPolyShape]

    column pp poly = map pp
      [ poly
      , map plFromPolygon $ plDecompose' 0.05 poly
      , map plFromPolygon $ plDecompose poly ]


    poly1 =
      svgToPolyShapes $ lowerTransformations $
      center $ scale 3 $
      latex "$\\Phi$"
    poly2 =
      svgToPolyShapes $ lowerTransformations $
      center $ scale 3 $
      latex "$\\vartheta$"
    poly3 =
      svgToPolyShapes $ lowerTransformations $
      center $ scale 3 $
      latex "$\\Xi$"
    poly4 =
      svgToPolyShapes $ lowerTransformations $
      center $ scale 3 $
      latex "$\\Theta$"

    ppA = renderPolyShapes
    ppB = lowerTransformations . scale 0.6 . center . renderPolyShapes
    std =
      withFillOpacity 1 .
      withFillColor "blue" .
      withStrokeWidth 0.01 .
      withStrokeColor "white"


boxPolyShape :: PolyShape
boxPolyShape = PolyShape $ G.ClosedPath
  [(G.Point 0 0, G.JoinLine)
  ,(G.Point 0 3, G.JoinLine)
  ,(G.Point 1 3, G.JoinLine)
  ,(G.Point 1 1, G.JoinLine)
  ,(G.Point 2 1, G.JoinLine)
  ,(G.Point 2 2, G.JoinLine)
  ,(G.Point 0 2, G.JoinLine)
  ,(G.Point 0 3, G.JoinLine)
  ,(G.Point 3 3, G.JoinLine)
  ,(G.Point 3 0, G.JoinLine)
  ]

{-
squarePolyShape :: PolyShape
squarePolyShape = PolyShape $ G.ClosedPath
  [(G.Point 0 0, G.JoinLine)
  ,(G.Point 1 0, G.JoinLine)
  ,(G.Point 1 1, G.JoinLine)
  ,(G.Point 0 1, G.JoinLine)]
-}

starPolyShape :: PolyShape
starPolyShape = PolyShape $ G.ClosedPath
  [(G.Point 0 0, G.JoinLine)
  ,(G.Point 1 2, G.JoinLine)
  ,(G.Point 2 0, G.JoinLine)
  ,(G.Point 0 1, G.JoinLine)
  ,(G.Point 2 1, G.JoinLine)
  ]

main :: IO ()
main = reanimate $ bg `parA` polygonTest
  where
    bg = animate $ const $ mkBackground "black"