Skip to content

Instantly share code, notes, and snippets.

@leftaroundabout
Created May 24, 2021 19:52
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save leftaroundabout/1731b244584d96e2071a05ac0f350203 to your computer and use it in GitHub Desktop.
Save leftaroundabout/1731b244584d96e2071a05ac0f350203 to your computer and use it in GitHub Desktop.
import Diagrams.Prelude
import Diagrams.Backend.Cairo
import Data.Colour.RGBSpace.HSV
import Data.Colour.SRGB.Linear
import Data.Numbers.Primes
import Control.Monad
import Text.Printf
trajectory :: Int -> Double -> P2 Double
trajectory i t = cos (t*k*pi) ^& sin (t*k'*pi)
where (k:k':_) = fromIntegral<$>(drop i primes :: [Int])
droplet :: Double -> P2 Double -> Diagram B
droplet r p@(P (V2 _ y))
= circle r
& moveTo p
& fc ptcColour
& lc ptcColour
where ptcColour = rgb r g b
where RGB r g b = hsv ((y+1)*160) 1 1
srate :: Num n => n
srate = 200
rainbowsnap :: Double -> Diagram B
rainbowsnap t
= mconcat [ droplet 0.05 (trajectory (round $ 12 - 0.3*j) $ tanh (t'*(4+j*3)))
| j <- [0 .. 30]
, t' <- let oversampling = 40
in [t + j/(oversampling*srate) | j<-[1..oversampling]] ]
<> (rect 5 3 & fc black)
main :: IO ()
main = do
forM_ [0 .. 2*srate] $ \i -> do
let t = fromIntegral (i :: Int) / srate - 1
renderCairo
(printf "rainbow_%03i.png" i)
(dims $ 300 ^& 180)
(rainbowsnap t)
@leftaroundabout
Copy link
Author

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment