{-# LANGUAGE OverloadedStrings #-}
module Main where
import Graphics.Rendering.Rect
import Stylist.Parse (parseProperties')
import Stylist (PropertyParser(..))
import Data.Text (pack, unpack)
import Data.CSS.Syntax.Tokens (tokenize, serialize)
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 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'
| otherwise = apply (shorthand self key val ++ props)
where self = apply props
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
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
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