content: {-|
  Module      : Widgets.CirclesGrid
  Copyright   : (c) 2018 Francisco Vallarino
  License     : BSD-3-Clause (see the LICENSE file)
  Maintainer  : fjvallarino@gmail.com
  Stability   : experimental
  Portability : non-portable
  
  Widget representing a grid of circles.
  -}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE FunctionalDependencies #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TemplateHaskell #-}
  
  module Widgets.CirclesGrid (
    CirclesGridCfg(..),
    HasItemWidth(..),
    HasSeed(..),
    circlesGrid
  ) where
  
  import Control.Lens
  import Control.Monad (when)
  import Data.Default
  import Data.Maybe
  import System.Random
  
  import Monomer.Graphics.ColorTable
  import Monomer.Widgets.Single
  
  -- Imported to avoid issues with duplicate lens names
  import Widgets.BoxesPalette
  
  import qualified Monomer.Lens as L
  
  data CirclesGridCfg = CirclesGridCfg {
    _cgcItemWidth :: Double,
    _cgcSeed :: Maybe Int
  } deriving (Eq, Show)
  
  instance Default CirclesGridCfg where
    def = CirclesGridCfg {
      _cgcItemWidth = 25,
      _cgcSeed = Just 42
    }
  
  data CirclesGridState = CirclesGridState {
    _cgcMouseX :: Double,
    _cgcMouseY :: Double
  } deriving (Eq, Show)
  
  makeLensesWith abbreviatedFields ''CirclesGridCfg
  makeLensesWith abbreviatedFields ''CirclesGridState
  
  circlesGrid :: CirclesGridCfg -> WidgetNode s e
  circlesGrid cfg = defaultWidgetNode "circlesGrid" widget where
    widget = makeCirclesGrid cfg (CirclesGridState 0 0)
  
  makeCirclesGrid :: CirclesGridCfg -> CirclesGridState -> Widget s e
  makeCirclesGrid cfg state = widget where
    widget = createSingle state def {
      singleUseScissor = True,
      singleMerge = merge,
      singleHandleEvent = handleEvent,
      singleGetSizeReq = getSizeReq,
      singleRender = render
    }
  
    merge wenv node oldNode oldState = resultNode newNode where
      newNode = node
        & L.widget .~ makeCirclesGrid cfg oldState
  
    handleEvent wenv node target evt = case evt of
      Move (Point x y) -> Just (resultReqs newNode [RenderOnce]) where
        newState = CirclesGridState x y
        newNode = node
          & L.widget .~ makeCirclesGrid cfg newState
      _ -> Nothing
  
    getSizeReq wenv node = (expandSize 100 1, expandSize 100 1)
  
    render wenv node renderer = do
      when (isJust (cfg ^. seed)) $
        setStdGen $ mkStdGen (fromJust $ cfg ^. seed)
  
      mapM_ (drawCircle renderer state vp iw cols) [0..cols * rows - 1]
      where
        style = currentStyle wenv node
        vp = getContentArea node style
        iw = cfg ^. itemWidth
        cols = round (vp ^. L.w / iw)
        rows = round (vp ^. L.h / iw)
  
  drawCircle
    :: Renderer -> CirclesGridState -> Rect -> Double -> Int -> Int -> IO ()
  drawCircle renderer state vp iw cols idx = do
    colorIdx :: Double <- randomIO
    offsetX <- randomIO
    offsetY <- randomIO
    let color = colors !! floor (fromIntegral (length colors) * colorIdx)
    let colorFill = color & L.a .~ 0.3
    beginPath renderer
    setStrokeWidth renderer 2
    setStrokeColor renderer color
    setFillColor renderer colorFill
    renderEllipse renderer (rect offsetX offsetY)
    fill renderer
    stroke renderer
    where
      colors = [cyan, deepPink, orange, paleGreen]
      sizeFactor = 0.3 + 1.1 * (state ^. mouseY - vp ^. L.y) / vp ^. L.h
      randFactor = (state ^. mouseX - vp ^. L.x) / vp ^. L.w
      currw = sizeFactor * iw
      szDiff = (1 - sizeFactor) * iw
      x = vp ^. L.x + iw * fromIntegral (idx `rem` cols)
      y = vp ^. L.y + iw * fromIntegral (idx `div` cols)
      rect ox oy = Rect rx ry currw currw where
        rx = x + randFactor * (ox - 0.5) * iw
        ry = y + randFactor * (oy - 0.5) * iw
  