import Reflex
import Reflex.Dom
import Data.Map as DM (Map, fromList)
import Data.Text (Text, pack)
import Data.List (transpose)


main :: IO ()
main = mainWidget $ do 
  elAttr "h1" ("style" =: "color:black") $ text "Kroneker Product Based Fractals" 
  elAttr "a" ("href" =: "http://rosettacode.org/wiki/Kronecker_product_based_fractals#Haskell") $ text "Rosetta Code / Kroneker product based fractals / Haskell"

  
  el "br" $ return ()
  elAttr "h2" ("style" =: "color:brown") $ text "Vicsek Fractal" 
  showFractal [[0, 1, 0] ,[1, 1, 1] ,[0, 1, 0] ]

  
  el "br" $ return ()
  elAttr "h2" ("style" =: "color:brown") $ text "Sierpinski Carpet Fractal" 
  showFractal [[1, 1, 1] ,[1, 0, 1] ,[1, 1, 1] ]


cellSize :: Int
cellSize = 8


showFractal :: MonadWidget t m => [[Int]] -> m ()
showFractal seed = do
  let boardAttrs w h = 
         fromList [ ("width" , pack $ show $ w * cellSize)
                  , ("height", pack $ show $ h * cellSize)
                  ]
      fractals = iterate (kronekerProduct seed) seed
      shown = fractals !! 3 
      w = length $ head shown
      h = length shown
  elSvgns "svg" (constDyn $ boardAttrs w h) $ showMatrix shown


kronekerProduct :: Num a => [[a]] -> [[a]] -> [[a]]
kronekerProduct xs ys = 
    let m0 = flip $ fmap.fmap.(*)
        m1 = flip $ fmap.fmap.m0
    in concat $ fmap (fmap concat.transpose) $ m1 xs ys


showMatrix :: MonadWidget t m => [[Int]] -> m ()
showMatrix m = mapM_ showRow $ zip [0..] m 


showRow :: MonadWidget t m => (Int,[Int]) -> m ()
showRow (x,r) = mapM_ (showCell x) $ zip [0..] r 


showCell :: MonadWidget t m => Int -> (Int,Int) -> m ()
showCell x (y,on) = 
  let boxAttrs (x,y) = 
        fromList [ ("transform", 
                    pack $    "scale (" ++ show cellSize ++ ", " ++ show cellSize ++ ") " 
                           ++ "translate (" ++ show x ++ ", " ++ show y ++ ")" 
                   )
                 ] 

      cellAttrs = 
        fromList [ ( "cx",      "0.5")
                 , ( "cy",      "0.5")
                 , ( "r",       "0.45")
                 , ( "style",   "fill:green")
                 ] 

  in if (on==1) then  
       elSvgns "g"  (constDyn $ boxAttrs (x,y)) $ 
         elSvgns "circle" (constDyn $ cellAttrs) $ 
           return ()
     else
       return ()


elSvgns :: MonadWidget t m => Text -> Dynamic t (Map Text Text) -> m a -> m a
elSvgns t m ma = do
    (el, val) <- elDynAttrNS' (Just "http://www.w3.org/2000/svg") t m ma
    return val