{-# 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