{-|
Module      : Reanimate.Builtin.Documentation
Copyright   : Written by David Himmelstrup
License     : Unlicense
Maintainer  : lemmih@gmail.com
Stability   : experimental
Portability : POSIX

This module contains convenience functions used in documention
GIFs for a consistent look and feel.

-}
module Reanimate.Builtin.Documentation where

import           Codec.Picture       (PixelRGB8, PixelRGBA8 (..), generateImage)
import           Reanimate.Animation (Animation, SVG, mapA, mkAnimation)
import           Reanimate.Constants (screenHeight, screenWidth)
import           Reanimate.Raster    (embedImage)
import           Reanimate.Svg

-- | Default environment for API documentation GIFs.
docEnv :: Animation -> Animation
docEnv :: Animation -> Animation
docEnv = (SVG -> SVG) -> Animation -> Animation
mapA ((SVG -> SVG) -> Animation -> Animation)
-> (SVG -> SVG) -> Animation -> Animation
forall a b. (a -> b) -> a -> b
$ \SVG
svg -> [SVG] -> SVG
mkGroup
  [ String -> SVG
mkBackground String
"white"
  , Double -> SVG -> SVG
withFillOpacity Double
0 (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$
    Double -> SVG -> SVG
withStrokeWidth Double
0.1 (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$
    String -> SVG -> SVG
withStrokeColor String
"black" ([SVG] -> SVG
mkGroup [SVG
svg]) ]

-- | <<docs/gifs/doc_drawBox.gif>>
drawBox :: Animation
drawBox :: Animation
drawBox = Double -> (Double -> SVG) -> Animation
mkAnimation Double
2 ((Double -> SVG) -> Animation) -> (Double -> SVG) -> Animation
forall a b. (a -> b) -> a -> b
$ \Double
t ->
  Double -> SVG -> SVG
partialSvg Double
t (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$ SVG -> SVG
pathify (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$
  Double -> Double -> SVG
mkRect (Double
forall a. Fractional a => a
screenWidthDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (Double
forall a. Fractional a => a
screenHeightDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)

-- | <<docs/gifs/doc_drawCircle.gif>>
drawCircle :: Animation
drawCircle :: Animation
drawCircle = Double -> (Double -> SVG) -> Animation
mkAnimation Double
2 ((Double -> SVG) -> Animation) -> (Double -> SVG) -> Animation
forall a b. (a -> b) -> a -> b
$ \Double
t ->
  Double -> SVG -> SVG
partialSvg Double
t (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$ SVG -> SVG
pathify (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$
  Double -> SVG
mkCircle (Double
forall a. Fractional a => a
screenHeightDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
3)

-- | <<docs/gifs/doc_drawProgress.gif>>
drawProgress :: Animation
drawProgress :: Animation
drawProgress = Double -> (Double -> SVG) -> Animation
mkAnimation Double
2 ((Double -> SVG) -> Animation) -> (Double -> SVG) -> Animation
forall a b. (a -> b) -> a -> b
$ \Double
t ->
  [SVG] -> SVG
mkGroup
  [ (Double, Double) -> (Double, Double) -> SVG
mkLine (-Double
forall a. Fractional a => a
screenWidthDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
widthP,Double
0)
           (Double
forall a. Fractional a => a
screenWidthDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
widthP,Double
0)
  , Double -> Double -> SVG -> SVG
translate (-Double
forall a. Fractional a => a
screenWidthDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
widthP Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
forall a. Fractional a => a
screenWidthDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
widthPDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
t) Double
0 (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$
    Double -> SVG -> SVG
withFillOpacity Double
1 (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$ Double -> SVG
mkCircle Double
0.5 ]
  where
    widthP :: Double
widthP = Double
0.8

-- | Render a full-screen view of a color-map.
showColorMap :: (Double -> PixelRGB8) -> SVG
showColorMap :: (Double -> PixelRGB8) -> SVG
showColorMap Double -> PixelRGB8
f = SVG -> SVG
center (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$ Double -> Double -> SVG -> SVG
scaleToSize Double
forall a. Fractional a => a
screenWidth Double
forall a. Fractional a => a
screenHeight (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$ Image PixelRGB8 -> SVG
forall a. PngSavable a => Image a -> SVG
embedImage Image PixelRGB8
img
  where
    width :: Int
width = Int
256
    height :: Int
height = Int
1
    img :: Image PixelRGB8
img = (Int -> Int -> PixelRGB8) -> Int -> Int -> Image PixelRGB8
forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> PixelRGB8
forall a p. Integral a => a -> p -> PixelRGB8
pixelRenderer Int
width Int
height
    pixelRenderer :: a -> p -> PixelRGB8
pixelRenderer a
x p
_y = Double -> PixelRGB8
f (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

-- | Default background color for videos on reanimate.rtfd.io
rtfdBackgroundColor :: PixelRGBA8
rtfdBackgroundColor :: PixelRGBA8
rtfdBackgroundColor = Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
252 Pixel8
252 Pixel8
252 Pixel8
0xFF