nanogenmo2018/pages/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_ rendere $ polymap (vadd (0.0, 0.0, 1.8)) $ polymap vtransform $ polyrotate (cubes 0.9) (0.6, 0.9, 0.32)

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

vtransform :: Vec3 -> Vec3
vtransform v@(x, y, z)
    | x < 0 = (vdiv v (vmag v))
    | x >= 0 = (vmul v (vmag v))

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

polyfilter :: (Vec3 -> Bool) -> [(Vec3, Vec3)] -> [(Vec3, Vec3)]
polyfilter f = filter (\(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.257

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