import Data.Complex
import Data.Ratio
import System.Environment (getArgs)

origin :: Complex Double
origin = 0

one :: Complex Double
one = 1

type Diagram = (Complex Double, Complex Double, String)

diagram :: [Rational] -> Diagram
diagram [] = (-one, origin, circle origin 0.1 "white")
diagram (q:qs) =
  let (dir, point, l) = diagram qs
      m = numerator q
      n = denominator q
      center = point + dir
      point' = center + dir'
      dir' = -dir * mkPolar (0.5 ** (1 / fromIntegral n))  (2 * pi * fromRational q)
  in  (dir', point',
      circle center 0.05 "black" `atop`
      circle point 0.1 "white" `atop`
      l `atop`
      line point center `atop`
      line center point' `atop`
      atops [ line center point''
            | i <- [2 .. n - 1]
            , let r = fromIntegral (n - (i - 1)) / fromIntegral n
            , let t = fromIntegral (i * m) / fromIntegral n
            , let point'' = center + dir' * mkPolar (0.5 ** r) (-2 * pi * t)
           ])

atop :: String -> String -> String
a `atop` b = b ++ a

atops :: [String] -> String
atops = foldr atop ""

sim :: Complex Double -> Complex Double -> Double -> Diagram -> String
sim o0 o1 s (_, i0, a)
  = translate o1
  . scale (if s == 0 then o1 - o0 else (o1 - o0) / mkPolar s (phase i0))
  $ a

sim2 :: Double -> Double -> Diagram -> String
sim2 d s a =
  sim (d*1/2:+d) (d:+d) s a ++
  sim (d*3/2:+d) (d:+d) s a

translate :: Complex Double -> String -> String
translate (x :+ y) a = "<g transform='translate(" ++ show x ++ " " ++ show y ++ ")'>" ++ a ++ "</g>"

scale z a = "<g transform='scale(" ++ show (magnitude z) ++ ") rotate(" ++ show (180/pi * phase z) ++ ")'>" ++ a ++ "</g>"

circle :: Complex Double -> Double -> String -> String
circle (cx:+cy) r fill = "<circle cx='" ++ show cx ++ "' cy='" ++ show cy ++ "' r='" ++ show r ++ "' fill='" ++ fill ++ "' />"

line :: Complex Double -> Complex Double -> String
line (x1:+y1) (x2:+y2) = "<line x1='" ++ show x1 ++ "' y1='" ++ show y1 ++ "' x2='" ++ show x2 ++ "' y2='" ++ show y2 ++ "' />"

svg :: Double -> Diagram -> String
svg s a = "<svg xmlns='http://www.w3.org/2000/svg' width='1024' height='1024' viewBox='0 0 1024 1024'>" ++
        "<rect x='-1' y='-1' width='1026' height='1026' fill='white' stroke='none' />" ++
        "<g stroke='black' stroke-width='0.01'>" ++
        sim2 512 s a ++
        "</g>" ++
        "</svg>"

mandelbrot :: String
mandelbrot =
        "<svg xmlns='http://www.w3.org/2000/svg' width='8192' height='8192' viewBox='0 0 8192 8192'>" ++
        "<rect x='-1' y='-1' width='8194' height='8194' fill='white' stroke='none' />" ++
        "<g stroke='black' stroke-width='0.1' stroke-linecap='round'>" ++
        js size0 center0 [] ++
        "</g>" ++
        "</svg>"
  where
    minSize = 4
    size0 = 2048
    center0 = 4096 :+ 4096

    -- draw a Julia set
    j r (x:+y) qs = sim ((x-r'):+y) (x:+y) s a ++ sim ((x+r'):+y) (x:+y) s a
      where a = diagram qs
            s = fromIntegral (length qs)
            r' = r / 2

    -- draw tree of Julia sets
    js size1 center1 qs =
      circle center1 size1 "silver" ++
      j size1 center1 qs ++
      concat  [ js size2 center2 qs'
              | d <- [1..floor (sqrt (size1 / minSize))]
              , let size2 = (size1 / fromIntegral d^2)
              , n <- [1 .. d - 1]
              , let q = n % d
              , denominator q == d
              , let qs' = qs ++ [if null qs then 1 - q else q]
              , let center2 = center1 + (-1)^length qs' * mkPolar (size1 + size2) (pi - 2 * pi * fromRational (sum qs'))
              ]

replaceSlash :: Char -> Char
replaceSlash '/' = '%'
replaceSlash c = c

main :: IO ()
main = do
  args <- getArgs
  if args == ["M"] then putStrLn mandelbrot else
    putStrLn $ svg (fromIntegral (length args)) $ diagram $ map (read . map replaceSlash) $ args