mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-18 03:12:40 +00:00
Update color-theory video to newest viewport.
Former-commit-id: 41848cad09eaa08a8f71afa1c8a004574cab507d
This commit is contained in:
David Himmelstrup
parent
df36127d8a
commit
e8bfdbee1b
2 changed files with 73 additions and 75 deletions
|
|
@ -21,6 +21,7 @@ import Reanimate.Monad
|
|||
import Reanimate.Raster
|
||||
import Reanimate.Signal
|
||||
import Reanimate.Svg
|
||||
import Reanimate.Constants
|
||||
import qualified Reanimate.Builtin.TernaryPlot as Ternary
|
||||
|
||||
labScaleX = 128
|
||||
|
|
@ -50,7 +51,7 @@ colorSpacesScene = mkAnimation 2 $ do
|
|||
-- center $
|
||||
-- scaleToWidth 100 $ img1
|
||||
-- ]
|
||||
, translate (-60) 10 $ mkGroup
|
||||
, translate (-screenWidth*0.2) 0 $ mkGroup
|
||||
[ -- withClipPathRef (Ref "sRGB") $
|
||||
--withClipPathRef (Ref "visible") $
|
||||
mkGroup [img1]
|
||||
|
|
@ -59,7 +60,7 @@ colorSpacesScene = mkAnimation 2 $ do
|
|||
, withStrokeColor "white" $
|
||||
obsColors
|
||||
]
|
||||
, translate (60) 10 $ mkGroup
|
||||
, translate (screenWidth*0.2) 0 $ mkGroup
|
||||
[ -- withClipPathRef (Ref "sRGB") $
|
||||
withClipPathRef (Ref "sRGB") $
|
||||
mkGroup [img1]
|
||||
|
|
@ -99,8 +100,7 @@ colorSpacesScene = mkAnimation 2 $ do
|
|||
img2 = cieLABImage imgSize imgSize
|
||||
obsColors =
|
||||
lowerTransformations $
|
||||
scaleXY 1 (-1) $
|
||||
scale (100) $
|
||||
scale 5 $
|
||||
renderXYZCoordinatesTernary
|
||||
labColors =
|
||||
lowerTransformations $
|
||||
|
|
@ -207,8 +207,7 @@ colorMapToXYZCoords colorMap = withFillOpacity 0 $ mkLinePath
|
|||
sRGBTriangle :: Tree
|
||||
sRGBTriangle =
|
||||
lowerTransformations $
|
||||
scaleXY 1 (-1) $
|
||||
scale 100 $
|
||||
scale 5 $
|
||||
withFillOpacity 0 $
|
||||
mkClosedLinePath
|
||||
[ Ternary.toOffsetCartesianCoords rY rX
|
||||
|
|
|
|||
|
|
@ -26,6 +26,7 @@ import Reanimate.Raster
|
|||
import Reanimate.Scene
|
||||
import Reanimate.Signal
|
||||
import Reanimate.Svg
|
||||
import Reanimate.Constants
|
||||
import System.IO.Unsafe
|
||||
|
||||
import Colorspace
|
||||
|
|
@ -41,58 +42,58 @@ dropA :: Double -> Animation -> Animation
|
|||
dropA d1 (Animation d2 f) = Animation (max 0 (d2-d1)) $
|
||||
Frame $ \d t -> unFrame f d (t+d1)
|
||||
|
||||
-- screen width 320
|
||||
-- screen height 180
|
||||
main :: IO ()
|
||||
main = reanimate $
|
||||
(mkAnimation 0 $ emit $ mkBackground "black") `sim`
|
||||
-- monalisaScene
|
||||
colorSpacesScene
|
||||
monalisaScene
|
||||
-- colorSpacesScene
|
||||
|
||||
|
||||
monalisaScene :: Animation
|
||||
monalisaScene =
|
||||
sceneAnimation (do
|
||||
-- wait blackIntro
|
||||
wait blackIntro
|
||||
-- Draw numbers
|
||||
-- fork $
|
||||
-- play $ drawHexPixels
|
||||
-- # setDuration toGrayScaleTime
|
||||
-- # pauseAtBeginning beginPause
|
||||
-- # fadeOut 2
|
||||
-- # fadeIn stdFade
|
||||
-- wait beginPause
|
||||
fork $
|
||||
play $ drawHexPixels
|
||||
# setDuration (drawPixelDelay+toGrayScaleTime)
|
||||
# pauseAtBeginning beginPause
|
||||
# fadeIn stdFade
|
||||
wait beginPause
|
||||
-- Schedule monalisa fade-in
|
||||
let PixelRGB8 minR _ _ = minPixel monalisa
|
||||
PixelRGB8 maxR _ _ = maxPixel monalisa
|
||||
waitAll $ do
|
||||
fork $ do
|
||||
playZ (-1) $ drawPixelImage 0 1
|
||||
play $ drawPixelImage (fromIntegral minR/255) ((fromIntegral maxR+1)/255)
|
||||
# setDuration toGrayScaleTime
|
||||
# pauseAround 1 5
|
||||
# pauseAround drawPixelDelay 5
|
||||
-- Move monalisa to the side of the screen
|
||||
play $ sceneFalseColorIntro
|
||||
|
||||
-- Show colormap as monalisa fades in
|
||||
play $ showColorMap 0 1
|
||||
play $ showColorMap (fromIntegral minR/255) ((fromIntegral maxR+1)/255)
|
||||
# setDuration toGrayScaleTime
|
||||
# pauseAround 1 1
|
||||
# fadeIn stdFade
|
||||
# fadeOut stdFade
|
||||
|
||||
-- Cycle through colormaps for monalisa
|
||||
play $ sceneColorMaps `sim` (sceneFalseColorChain $ map snd
|
||||
[ ("Greyscale", greyscale)
|
||||
, ("Jet", jet)
|
||||
, ("Turbo", turbo)
|
||||
, ("Viridis", viridis)
|
||||
, ("Parula", parula)
|
||||
, ("Plasma", plasma)
|
||||
, ("Cividis", cividis)
|
||||
])
|
||||
-- play $ sceneColorMaps `sim` (sceneFalseColorChain $ map snd
|
||||
-- [ ("Greyscale", greyscale)
|
||||
-- , ("Jet", jet)
|
||||
-- , ("Turbo", turbo)
|
||||
-- , ("Viridis", viridis)
|
||||
-- , ("Parula", parula)
|
||||
-- , ("Plasma", plasma)
|
||||
-- , ("Cividis", cividis)
|
||||
-- ])
|
||||
return ()
|
||||
)
|
||||
where
|
||||
blackIntro = 2
|
||||
beginPause = 4
|
||||
drawPixelDelay = 1
|
||||
stdFade = 0.3
|
||||
toGrayScaleTime = 3
|
||||
|
||||
|
|
@ -107,6 +108,12 @@ monalisa = unsafePerformIO $ do
|
|||
monalisaLarge :: Image PixelRGB8
|
||||
monalisaLarge = scaleImage 15 monalisa
|
||||
|
||||
maxPixel :: Image PixelRGB8 -> PixelRGB8
|
||||
maxPixel img = pixelFold (\acc _ _ pix -> max acc pix) (pixelAt img 0 0) img
|
||||
|
||||
minPixel :: Image PixelRGB8 -> PixelRGB8
|
||||
minPixel img = pixelFold (\acc _ _ pix -> min acc pix) (pixelAt img 0 0) img
|
||||
|
||||
scaleImage :: Pixel a => Int -> Image a -> Image a
|
||||
scaleImage factor img =
|
||||
generateImage fn (imageWidth img * factor) (imageHeight img * factor)
|
||||
|
|
@ -139,31 +146,31 @@ sceneFalseColorIntro = mkAnimation 2 $ do
|
|||
s <- getSignal $ signalFromTo 1 2 $ signalCurve 3
|
||||
d <- getSignal $ signalCurve 3
|
||||
emit $
|
||||
translate ((320/4 - 15)*d) 0 $
|
||||
scaleToSize (320/s) (180/s) $
|
||||
translate ((screenWidth/4 - 0.75)*d) 0 $
|
||||
scaleToSize (screenWidth/s) (screenHeight/s) $
|
||||
center $ embedImage monalisaLarge
|
||||
emit $
|
||||
withGroupOpacity d $
|
||||
translate ((320/4 - 15)*d) 0 $
|
||||
scaleToSize (320/s) (180/s) $
|
||||
center $ embedImage monalisa
|
||||
translate ((screenWidth/4 - 0.75)*d) 0 $
|
||||
scaleToSize (screenWidth/s) (screenHeight/s) $
|
||||
embedImage monalisa
|
||||
|
||||
sceneFalseColor :: (Double -> PixelRGB8) -> (Double -> PixelRGB8) -> Animation
|
||||
sceneFalseColor cmap1 cmap2 = mkAnimation 5 $ do
|
||||
s <- getSignal $ signalCurve 3
|
||||
let cm = interpolateColorMap s cmap1 cmap2
|
||||
emit $ translate (320/4 - 15) 0 $
|
||||
scaleToSize (320/2) (180/2) $ center $ embedImage $
|
||||
emit $ translate (screenWidth/4 - 0.75) 0 $
|
||||
scaleToSize (screenWidth/2) (screenHeight/2) $ embedImage $
|
||||
applyColorMap cm monalisa
|
||||
|
||||
sceneColorMaps :: Animation
|
||||
sceneColorMaps = mkAnimation 5 $ do
|
||||
emit $ mkGroup
|
||||
[ translate xOffset (yInit + n*yStep) $
|
||||
[ translate xOffset (yInit - n*yStep) $
|
||||
mkGroup
|
||||
[ renderColorMap width height cmap
|
||||
, withFillColor "white" $ translate (-width/2) (-height) $
|
||||
scale 0.5 $ latex name
|
||||
, withFillColor "white" $ translate (-width/2) (height*1) $
|
||||
scale 0.3 $ latex name
|
||||
]
|
||||
| (n, (name, cmap)) <- zip [0..] maps ]
|
||||
where
|
||||
|
|
@ -175,31 +182,20 @@ sceneColorMaps = mkAnimation 5 $ do
|
|||
, ("Parula", parula)
|
||||
, ("Plasma", plasma)
|
||||
, ("Cividis", cividis) ]
|
||||
xOffset = -95
|
||||
yInit = -yStep*3
|
||||
xOffset = -screenWidth*0.3
|
||||
yInit = yStep*3
|
||||
yStep = height * 2.2
|
||||
width = 100
|
||||
height = 10
|
||||
width = screenWidth*0.4
|
||||
height = screenHeight*0.06
|
||||
|
||||
|
||||
deResImage :: Animation
|
||||
deResImage = mkAnimation 5 $ do
|
||||
s <- getSignal $ signalLinear
|
||||
emit $ withGroupOpacity s $ --translate (320/4) 0 $
|
||||
scaleToSize (320/1) (180/1) img1
|
||||
emit $ withGroupOpacity (1-s) $ --translate (320/4) 0 $
|
||||
scaleToSize (320/1) (180/1) img2
|
||||
where
|
||||
img1 = preRender $ center $ embedImage monalisa
|
||||
img2 = preRender $ center $ embedImage monalisaLarge
|
||||
|
||||
limitGreyPixels :: Word8 -> Image PixelRGB8 -> Image PixelRGB8
|
||||
limitGreyPixels :: Word8 -> Image PixelRGB8 -> Image PixelRGBA8
|
||||
limitGreyPixels limit img =
|
||||
generateImage fn (imageWidth img) (imageHeight img)
|
||||
where
|
||||
fn x y =
|
||||
let pixel@(PixelRGB8 r _ _) = pixelAt img x y
|
||||
in if r < limit then pixel else PixelRGB8 limit limit limit
|
||||
in if r < limit then promotePixel pixel else PixelRGBA8 0 0 0 1 --limit limit limit
|
||||
|
||||
latexTest :: Animation
|
||||
latexTest = mkAnimation 5 $ do
|
||||
|
|
@ -215,42 +211,45 @@ latexTest = mkAnimation 5 $ do
|
|||
renderColorMap :: Double -> Double -> (Double -> PixelRGB8) -> Tree
|
||||
renderColorMap width height cmap = mkGroup
|
||||
[ scaleToSize width height $ mkColorMap cmap
|
||||
, center $ withStrokeWidth (Num 0.5) $
|
||||
, center $ withStrokeWidth (Num 0.01) $
|
||||
withStrokeColor "white" $ withFillOpacity 0 $
|
||||
mkRect (Num width) (Num height)
|
||||
]
|
||||
|
||||
showColorMap :: Double -> Double -> Animation
|
||||
showColorMap start end = mkAnimation 2 $ do
|
||||
s <- getSignal $ signalFromTo start end $ signalCurve 2
|
||||
s <- getSignal $ signalCurve 2
|
||||
let n = signalFromTo start end id s
|
||||
emit $
|
||||
translate 0 (60) $
|
||||
translate 0 offsetY $
|
||||
mkGroup
|
||||
[ withGroupOpacity 0.7 $
|
||||
[ withGroupOpacity 0.9 $
|
||||
withFillColor "black" $
|
||||
translate 0 (-7) $
|
||||
translate 0 (0) $
|
||||
center $
|
||||
mkRect (Num $ width * 1.2) (Num $ height*3)
|
||||
, scaleToSize width height $ mkColorMap cm
|
||||
mkRect (Num $ width + height*2) (Num $ height*3)
|
||||
, scaleToSize width height $ mkColorMap (cm . signalFromTo start end id)
|
||||
, translate (s*width - width/2) 0 $
|
||||
center $
|
||||
withStrokeColor "black" $
|
||||
mkLine (Num 0, Num 0) (Num 0, Num height)
|
||||
, center $ withStrokeWidth (Num 0.5) $
|
||||
, center $ --withStrokeWidth (Num 0.5) $
|
||||
withStrokeColor "white" $ withFillOpacity 0 $
|
||||
mkRect (Num width) (Num height)
|
||||
, translate (s*width - width/2) (-height-5) $
|
||||
, translate (s*width - width/2) (height) $
|
||||
scale 0.3 $
|
||||
centerX $
|
||||
withStrokeWidth (Num 0.2) $
|
||||
withFillColorPixel (promotePixel $ cm s) $
|
||||
-- withStrokeWidth (Num 0.2) $
|
||||
withFillColorPixel (promotePixel $ cm n) $
|
||||
withStrokeColor "white" $
|
||||
getNthSet (round (s*255) `div` stepSize * stepSize)
|
||||
getNthSet (round (n*255) `div` stepSize * stepSize)
|
||||
]
|
||||
where
|
||||
cm = greyscale
|
||||
offsetY = -screenHeight*0.30
|
||||
stepSize = 0x1
|
||||
width = 150
|
||||
height = 15
|
||||
width = screenWidth*0.50
|
||||
height = screenHeight*0.08
|
||||
ppHex n = T.pack $ reverse (take 2 (reverse (showHex n "") ++ repeat '0'))
|
||||
getNthSet n = snd (splitGlyphs [n*2,n*2+1] allGlyphs)
|
||||
allGlyphs = lowerTransformations $ scale 2 $ center $ latex $ "\\texttt{" <> T.concat
|
||||
|
|
@ -270,7 +269,7 @@ mkColorMap f = center $ embedImage img
|
|||
drawPixelImage :: Double -> Double -> Animation
|
||||
drawPixelImage start end = mkAnimation 2 $ do
|
||||
limit <- getSignal $ signalFromTo start end $ signalCurve 2
|
||||
emit $ scaleToSize 320 180 $ center $ embedImage $
|
||||
emit $ scaleToSize screenWidth screenHeight $ center $ embedImage $
|
||||
limitGreyPixels (floor (limit*255)) monalisaLarge
|
||||
|
||||
drawHexPixels :: Animation
|
||||
|
|
@ -279,8 +278,8 @@ drawHexPixels = mkAnimation 1 $ do
|
|||
emit $ defs
|
||||
emit $ withFillOpacity 1 $ withStrokeWidth (Num 0) $ withFillColor "white" $
|
||||
mkGroup
|
||||
[ translate ((fromIntegral x+0.5)/fromIntegral width*320 - 320/2)
|
||||
((fromIntegral y+0.5)/fromIntegral height*180 - 180/2) $
|
||||
[ translate ((fromIntegral x+0.5)/fromIntegral width*screenWidth - screenWidth/2)
|
||||
(screenHeight/2 - (fromIntegral y+0.5)/fromIntegral height*screenHeight) $
|
||||
if highdef
|
||||
then mkUse ("tag" ++ show r)
|
||||
else mkCircle (Num 0.5)
|
||||
|
|
@ -291,7 +290,7 @@ drawHexPixels = mkAnimation 1 $ do
|
|||
where
|
||||
defs = preRender $ mkDefinitions images
|
||||
getNthSet n = centerX $ snd (splitGlyphs [n*2,n*2+1] allGlyphs)
|
||||
allGlyphs = lowerTransformations $ scale 0.3 $ center $ latex $
|
||||
allGlyphs = lowerTransformations $ scale 0.15 $ center $ latex $
|
||||
"\\texttt{" <> T.concat
|
||||
[ ppHex n
|
||||
| n <- [0..255]
|
||||
|
|
|
|||
Loading…
Reference in a new issue