gruff-examples-0.3: src/gruff-labels.hs

import Fractal.GRUFF

import Fractal.RUFF.Mandelbrot.Address
import Fractal.RUFF.Mandelbrot.Ray
import Fractal.RUFF.Mandelbrot.Atom
import Fractal.RUFF.Types.Complex

import Control.Monad (ap, replicateM)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)

main :: IO ()
main = defaultMain [(labels, "gruff-labels.ppm")]

labels :: Image
labels = Image
  { imageWindow   = Window{ width = 1280, height = 720, supersamples = 8 }
  , imageViewport = Viewport{ aspect =16/9, orient = 0 }
  , imageLocation = Location{ center = (-0.1178) :+ 1.0413, radius = 0.125 }
  , imageColours  = Colours
      { colourInterior = red
      , colourBoundary = black
      , colourExterior = darkgrey
      }
  , imageLabels   = rayLabels ++ atomLabels
  , imageLines   = rayLines
  }

addressSpec :: [String]
addressSpec =
  [ "1 1/3 " ++ (unwords . map show . scanl (+) (3 :: Int)) steps
  | n <- [1 .. 3]
  , steps <- replicateM n [1,2,3]
  ] 

addresses :: [AngledInternalAddress]
addresses = mapMaybe parseAngledInternalAddress addressSpec

atoms :: [(AngledInternalAddress, MuAtom Double)]
atoms = mapMaybe (\addr -> fmap ((,) addr) (findAtom_ addr)) addresses

angles :: [(AngledInternalAddress, MuAtom Double, Angle, Angle)]
angles = mapMaybe f atoms
  where
    f (addr, mu) = fmap g (externalAngles addr)
      where
        g (lo, hi) = (addr, mu, lo, hi)

atomLabels :: [Label]
atomLabels =
  [ Label
    { labelCoords = toRationalC (muNucleus mu)
    , labelColour = white
    , labelText = prettyAngledInternalAddress addr
    }
  | (addr, mu, _, _) <- angles
  ]

rayLabels :: [Label]
rayLabels =
  [ Label
    { labelCoords = fst . (!! (sharpness * k)) $ rays M.! a
    , labelColour = lightgrey, labelText = prettyAngle a
    }
  | (_, _, lo, hi) <- angles
  , (a, k) <- [(lo, 10), (hi, 11)]
  ]

rayLines :: [Line]
rayLines =
  [ Line{ lineSegments = rs, lineColour = midgrey }
  | rs <- M.elems rays
  ]

rays :: M.Map Angle [(Complex Rational, Complex Rational)]
rays = M.fromList [ (a, ray a) | (_, _, lo, hi) <- angles, a <- [lo, hi] ]

ray :: Angle -> [(Complex Rational, Complex Rational)]
ray = (zip`ap`tail)
    . map toRationalC
    . take (sharpness * 32)
    . externalRay 1e-8 sharpness (2**24)

sharpness :: Int
sharpness = 8

red, black, darkgrey, midgrey, lightgrey, white :: Colour
red = Colour 1 0 0
black = Colour 0 0 0
darkgrey = Colour 0.25 0.25 0.25
midgrey = Colour 0.5 0.5 0.5
lightgrey = Colour 0.75 0.75 0.75
white = Colour 1 1 1

toRationalC :: Complex Double -> Complex Rational
toRationalC (x :+ y) = toRational x :+ toRational y