module Main where

import Prelude hiding (putStrLn)
import System.IO.UTF8
import BrownPLT.JavaScript.Syntax
import BrownPLT.JavaScript.PrettyPrint
import Control.Monad
import Control.Monad.RWS
import Language.JSMW

import DOMHelper

import Foreign.WebIDL.Dom.Document
import Foreign.WebIDL.Dom.Element
import Foreign.WebIDL.Dom.Node
import Foreign.WebIDL.Html2.HTMLElement
import Foreign.WebIDL.Html2.HTMLDivElement
import Foreign.WebIDL.Html2.HTMLImageElement hiding (getm'width, set'border)
import Foreign.WebIDL.Html2.HTMLTableElement hiding (getm'width, set'width)
import Foreign.WebIDL.Html2.HTMLTableRowElement
import Foreign.WebIDL.Html2.HTMLTableCellElement hiding (getm'width, set'height, set'width)
import Foreign.WebIDL.Views.ElementView
import Foreign.WebIDL.Views.ClientRect

main = putStrLn $ show $ stmt $ FunctionStmt undefined (Id undefined "calpic") [
  Id undefined "u"
 ,Id undefined "yr"
 ,Id undefined "mn"
 ,Id undefined "n"] $ getBlock $ runJSMWWith currDocBody 0 $ calpic (
    VarRef undefined (Id undefined "u")
   ,VarRef undefined (Id undefined "yr")
   ,VarRef undefined (Id undefined "mn")
   ,VarRef undefined (Id undefined "n"))

instance JContainer TElement
instance JContainer THTMLDivElement
instance JContainer THTMLImageElement
instance JContainer THTMLTableElement
instance JContainer THTMLTableRowElement
instance JContainer THTMLTableCellElement

calpic :: (JContainer e, CNode e, CElement e) =>
          (Expression String
          ,Expression Double 
          ,Expression String 
          ,Expression Double)
        -> JSMW e () (Expression ())


calpic (u, yr, mn, n) = do
  doc <- ask >>= getm'ownerDocument
  pfrdiv' <- getElementById (string "picframe") doc >>= return . asHTMLDivElement >>= once
  switch (isNull pfrdiv') $ do
    False --> do
      pe <- getm'parentNode pfrdiv'
      switch (isNull pe) $ do
        True --> return unit
        False --> do
          once =<< return . asNode =<< removeChild pfrdiv' pe
          return unit
      return unit
    True --> return unit
  [tyr, tn] <- mapM toString [yr, n]
  let dts = tyr + mn + tn
  p <- extRef "calendar" >>= readJSRef >>= getjsProperty dts
  em <- emptymap
  picmsg <- iterseq em p $ \e mp -> do
    fs <- iterseq true (strseq e) $ \c f -> stop (c === string "*")
    prop <- switch fs $ do
      True --> stringM "msg"
      False --> stringM "pic"
    z <- getval prop mp >>= append e
    store prop z mp
    continue mp
  pp <- getval (string "pic") picmsg
  npics <- iterseq (number 0) pp $ \e n -> continue (n + 1)
  dayrect <- getRectById dts doc
  switch (isNull dayrect) $ do
    True --> return unit
    False --> do
      x1 <- getm'left dayrect
      x2 <- getm'right dayrect
      y1 <- getm'top dayrect
      y2 <- getm'bottom dayrect
      top <- toString y2
      lft <- toString x1
      let hgtn = (y2 - y1) * 3
	  wdtn = (x2 - x1) * 2
          bordern = 2
      hgt <- toString hgtn
      border <- toString bordern
      wdt <- toString (wdtn * npics)
      pfrdiv <- container mkDiv $ do
	runSetters [set'id (string "picframe")]
	setStyle ["position" := string "absolute"
		 ,"top" := top + string "px"
		 ,"left" := lft + string "px"
		 ,"width" := wdt + string "px"
		 ,"height" := string "auto"
                 ,"border" := string "0px"
		 ,"overflow-x" := string "hidden"
		 ,"overflow-y" := string "hidden"]
      inside pfrdiv $ do
	container mkTable $ do
	  runSetters [set'border (string "0px")
		     ,set'cellPadding (string "0px")
		     ,set'cellSpacing (string "0px")]
	  container mkTr $ do
            setStyle ["border" := string "0px"]
	    tr <- ask
	    iterseq (number 0) pp $ \e a -> do
	      inside tr $ do
		container mkTd $ do
		  setStyle ["vertical-align" := string "top"
                           ,"align" := string "center"
                           ,"border" := string "0px"
			   ,"padding" := string "0px"]
		  container mkImg $ runSetters [set'width (wdtn - bordern * 2)
					       ,set'src e]
	      continue a
      msgdiv <- getElementById (string "botdiv") doc >>= return . asHTMLDivElement >>= once
      switch (isNull msgdiv) $ do
	True --> return unit
	False --> do
	  mm <- getval (string "msg") picmsg
	  inside msgdiv $ do
	    o <- ask
	    itermut (number 0) o $ \e a -> do
	      hch <- hasChildNodes e
	      switch hch $ do
		False --> stop a
		True --> do
		  fch <- getm'firstChild e
		  once =<< return . asNode =<< removeChild fch e
		  continue a
	  iterseq (number 0) mm $ \e a -> do
	    inside msgdiv $ container mkDiv $ do
	      setStyle ["font-weight" := string "bold"
		       ,"font-size" := string "14pt"
		       ,"color" := string "blue"]
	      passive (mkText e)
	    continue a
	  return unit