nanogenmo2018/pages/anim-8.hs

{-# LANGUAGE OverloadedStrings #-}

import Data.List
import Text.LaTeX
import Text.LaTeX.Base.Class
import Text.LaTeX.Base.Syntax
import Text.LaTeX.Packages.Graphicx
import Text.LaTeX.Packages.Geometry
import Util
import Vec

main :: IO ()
main = printdoc doc

doc :: Monad m => LaTeXT_ m
doc = do
    mapM_ id $ intersperse (raw "\n\\mbox{}\\clearpage{}\n") $ fmap renderd [0.0, pi / 8 .. pi * 15 / 8]

renderd :: Monad m => Double -> LaTeXT_ m
renderd x = do
    mapM_ rendere $ polymap (vadd (0.0, 0.0, 3.0)) $ polyrotate sphere (0.0, x, 0.3)


rendere :: LaTeXC l => (Vec3, Vec3) -> l
rendere (a, b) =
    if d > 0.001 then textblock' (vw $ fst c) (vw $ snd c) $ rotatebox' ((-t ) * 180 / pi) $ fontsize (vw $ d * 0.222) (vw 0) "collapsing"
    else ""
  where
    c = vadd a' $ vdiv (vsub b' a') 2
    d = vdist a' b'
    t = atan2 (snd $ vsub b' a') (fst $ vsub b' a')
    a' = vadd (0.5, sqrt 2 / 2) $ vmul (vproject a) 1
    b' = vadd (0.5, sqrt 2 / 2) $ vmul (vproject b) 1

sphere :: [(Vec3, Vec3)]
sphere = polymap (\x -> vdiv x (vmag x)) $ polyrotate (cubes 0.9) (0.6, 0.9, 0.32)

polymap :: (Vec3 -> Vec3) -> [(Vec3, Vec3)] -> [(Vec3, Vec3)]
polymap f = fmap (\(a, b) -> (f a, f b))

polyrotate :: [(Vec3, Vec3)] -> Vec3 -> [(Vec3, Vec3)]
polyrotate vs t = polymap (flip v3rotate t) vs

cubes :: Double -> [(Vec3, Vec3)]
cubes r = connect dist $ vcubes r
  where
    connect dist xs = [(x, y) | (x:ys) <- tails xs, y <- ys, vdist x y < dist]
    dist = r * 0.251

vcubes :: Double -> [Vec3]
vcubes r = fmap (flip vmul r) vs
  where
    vs = [(x, y, z) | x <- a, y <- a, z <- b]
    a = [-1, -3/4 .. 1]
    b = [-1, -3/4 .. 1]

phi :: Double
phi = (1 + sqrt 5) / 2