import Reflex
import Reflex.Dom
import Reflex.Dom.Time
import Data.Text (Text, pack) 
import Data.Map (Map, fromList)
import Data.Time.Clock (getCurrentTime)
import Control.Monad.Trans (liftIO)

type Point = (Float,Float)
type Segment = (Point,Point)

main = mainWidget $ do 

  
  dTick <- tickLossy 0.05 =<< liftIO getCurrentTime 

  
  dCounter <- foldDyn (\_ c -> c+1) (0::Int) dTick

  let 
      
      dAngle = fmap (\c -> fromIntegral c / 800.0) dCounter

      
      dSpiralMap = fmap toSpiralMap dAngle

      
      width = 600
      height = 600

      boardAttrs = 
         fromList [ ("width" , pack $ show width)
                  , ("height", pack $ show height)
                  , ("viewBox", pack $ show (-width/2) ++ " " ++ show (-height/2) ++ " " ++ show width ++ " " ++ show height)
                  ]

  elAttr "h1" ("style" =: "color:black") $ text "Polyspiral" 
  elAttr "a" ("href" =: "http://rosettacode.org/wiki/Polyspiral#Haskell") $ text "Rosetta Code / Polyspiral / Haskell"

  el "br" $ return ()
  elSvgns "svg" (constDyn boardAttrs) (listWithKey dSpiralMap showLine)

  return ()


lineAttrs :: Segment -> Map Text Text
lineAttrs ((x1,y1), (x2,y2)) =
  fromList [ ( "x1",    pack $ show x1)
           , ( "y1",    pack $ show y1)
           , ( "x2",    pack $ show x2)
           , ( "y2",    pack $ show y2)
           , ( "style", "stroke:blue")
           ]    


showLine :: MonadWidget t m => Int -> Dynamic t Segment -> m ()
showLine _ dSegment = elSvgns "line" (lineAttrs <$> dSegment) $ return ()


advance :: Float -> (Point, Float, Float) -> (Point, Float, Float)
advance angle ((x,y), len, rot) = 
  let new_x = x + len * cos rot
      new_y = y + len * sin rot
      new_len = len + 3.0 
      new_rot = rot + angle
  in ((new_x, new_y), new_len, new_rot)


toSpiralMap :: Float -> Map Int ((Float,Float),(Float,Float))
toSpiralMap angle =
      fromList                       
  $   zip [0..]                      
  $   (\pts -> zip pts $ tail pts)   
  $   take 80                        
  $   (\(pt,_,_) -> pt)              
  <$> iterate (advance angle) ((0, 0), 0, 0)  


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