-- Before you can install the SFML Haskell library, you need to install
-- the CSFML C library.  (For example, "brew install csfml" on OS X.)

-- This program runs in fullscreen mode.
-- Press any key or mouse button to exit.

import Control.Exception
import SFML.Graphics
import SFML.SFResource
import SFML.Window hiding (width, height)

withResource :: SFResource a => IO a -> (a -> IO b) -> IO b
withResource acquire = bracket acquire destroy

withResources :: SFResource a => IO [a] -> ([a] -> IO b) -> IO b
withResources acquire = bracket acquire (mapM_ destroy)

colors :: [Color]
colors = [black, red, green, magenta, cyan, yellow, white]

makeBar :: (Float, Float) -> (Color, Int) -> IO RectangleShape
makeBar (barWidth, height) (c, i) = do
  bar <- err $ createRectangleShape
  setPosition  bar $ Vec2f (fromIntegral i * barWidth) 0
  setSize      bar $ Vec2f barWidth height
  setFillColor bar c
  return bar

barSize :: VideoMode -> (Float, Float)
barSize (VideoMode w h _ ) = ( fromIntegral w / fromIntegral (length colors)
                             , fromIntegral h )

loop :: RenderWindow -> [RectangleShape] -> IO ()
loop wnd bars = do
  mapM_ (\x -> drawRectangle wnd x Nothing) bars
  display wnd
  evt <- waitEvent wnd
  case evt of
    Nothing -> return ()
    Just SFEvtClosed -> return ()
    Just (SFEvtKeyPressed {}) -> return ()
    Just (SFEvtMouseButtonPressed {}) -> return ()
    _ -> loop wnd bars

main :: IO ()
main = do
  vMode <- getDesktopMode
  let wStyle = [SFFullscreen]
  withResource (createRenderWindow vMode "color bars" wStyle Nothing) $
     \wnd -> withResources (mapM (makeBar $ barSize vMode) $ zip colors [0..]) $
     \bars -> loop wnd bars