{-# LANGUAGE OverloadedStrings #-}
module Main where

import Graphics.Rendering.Rect
import Stylist.Parse (parseProperties')
import Stylist (PropertyParser(..))
import Data.Text (Text, pack, unpack)
import Data.CSS.Syntax.Tokens (tokenize, serialize, Token(Whitespace))

import SDL hiding (trace)
import Graphics.GL.Core32
import System.Environment (getArgs)
import Linear.Projection (ortho)

import Data.Function (fix)
import Control.Monad (unless)
import Control.Monad.IO.Class (MonadIO (..))

import Codec.Picture (DynamicImage(..), Image(..), PixelRGBA8(..),
                        readImage, generateImage)

import Debug.Trace (trace) -- To warn about invalid args

parseStyle syn
    | (ret, []) <- parseProperties' toks = apply ret
    | (ret, tail) <- parseProperties' toks =
        trace ("Extraneous chars: " ++ unpack (serialize tail)) $ apply ret
  where
    toks = tokenize $ pack syn
    apply ((key, val):props)
        | Just self' <- longhand self self key val' = self'
        | props'@(_:_) <- shorthand self key val' = apply (props' ++ props)
        | otherwise = trace ("Unsupported property " ++ unpack key) self
      where
        self = apply props
        val' = filter (/= Whitespace) val
    apply [] = temp

orthoProjection (V2 ww wh) =
  let (hw,hh) = (fromIntegral ww, fromIntegral wh)
  in ortho 0 hw hh 0 0 1

main :: IO ()
main = do
    SDL.initializeAll
    args <- getArgs
    let style :: RectStyle Text
        style = case args of
            [] -> trace "Using blank styles, should see blank screen!" temp
            [arg] -> parseStyle arg
            (arg:_) -> trace "Extraneous commandline args!" $ parseStyle arg

    let openGL = defaultOpenGL { glProfile = Core Debug 3 3 }
        wcfg = defaultWindow {
            windowInitialSize = V2 640 480,
            windowGraphicsContext = OpenGLContext openGL,
            windowResizable = True
          }
    w <- createWindow "Mondrian" wcfg
    _ <- glCreateContext w

    atlas <- atlasFromStyles loadImage [style]
    let style' = styleResolveImages atlas style

    render <- renderRects
    fix $ \loop -> do
        events <- fmap eventPayload <$> pollEvents
        liftIO $ glClearColor 1 1 1 1
        liftIO $ glClear GL_COLOR_BUFFER_BIT

        sz@(V2 dw dh) <- liftIO $ glGetDrawableSize w
        liftIO $ glViewport 0 0 (fromIntegral dw) (fromIntegral dh)

        let rect = Rect 0 0 (fromIntegral dw) (fromIntegral dh)
            rects = Rects (shrink1 rect 15) (shrink1 rect 10) (shrink1 rect 5) rect

        render style' rects $ orthoProjection sz

        liftIO $ glSwapWindow w
        unless (QuitEvent `elem` events) loop

loadImage "" = return $ ImageRGBA8 $ generateImage transparent 1 1
loadImage path = do
    ret <- readImage $ unpack path
    return $ case ret of
        Right x -> x
        Left _ -> ImageRGBA8 $ generateImage transparent 1 1
transparent _ _ = PixelRGBA8 0 0 0 0