{-# OPTIONS_HADDOCK prune #-}

module Gleam
  ( play
  , playMultiple
  , module Picture
  , module InputEvent
  , module Color
  , module Settings
  )
where

import qualified Graphics.UI.Threepenny        as UI
import           Graphics.UI.Threepenny.Core
import           Control.Monad
import           Data.IORef
import           Control.Monad.Trans            ( liftIO )
import           Picture
import           Animate
import           InputEvent
import           Handler
import           Utility
import           Color
import           Settings

config = defaultConfig { jsStatic = Just "./images" }

-- | Run a simulation in a window. You decide how the model is represented, how to convert the model to a picture and how to update the model. This function does the rest. The simulation can be seen on `127.0.0.1:8023`
play
  :: GleamConfig                    -- ^ Canvas size.
  -> model                          -- ^ Initial model for the simulation.
  -> (model -> Picture)             -- ^ Function to generate a picture from a model.
  -> (model -> model)               -- ^ Function to update the state of the simulation.
  -> (InputEvent -> model -> model) -- ^ Function to handle input events.
  -> IO ()
play gleamconfig initialModel draw update handler =
  startGUI config $ setup gleamconfig initialModel draw update handler

-- | Run multiple simulations in a window. You decide how each model is represented, how to convert each model to a picture and how to update the model. This function does the rest. The simulations can be seen on `127.0.0.1:8023`
playMultiple :: [Simulation] -> IO ()
playMultiple simulations = startGUI config $ setupMultiple simulations

setup
  :: GleamConfig                    -- ^ Canvas size.
  -> model                          -- ^ Initial model for the simulation.
  -> (model -> Picture)             -- ^ Function to generate a picture from a model.
  -> (model -> model)               -- ^ Function to update the state of the simulation.
  -> (InputEvent -> model -> model) -- ^ Function to handle input events.
  -> Window
  -> UI ()
setup gleamconfig initialModel draw update handler window = do
  return window # set title "ThreePennyGloss"

  canvas <-
    UI.canvas
    # set UI.width  (width gleamconfig)
    # set UI.height (height gleamconfig)
    # set UI.style  [("background", "#bbb")]

  canvas # setAttribute "tabindex" "1"

  getBody window #+ [element canvas]

  currentState    <- liftIO $ newIORef initialModel

  currentMousePos <- liftIO $ newIORef (0.0, 0.0)

  handleEvents gleamconfig currentState currentMousePos (handler) canvas

  animate currentState (update) (draw) canvas

  return ()

setupMultiple :: [Simulation] -> Window -> UI ()
setupMultiple simulations window = do
  return window # set title "ThreePennyGloss"
  simulate simulations window
  return ()

simulate :: [Simulation] -> Window -> UI ()
simulate ([]) _ = do
  return ()
simulate ((Simulation simConfig simInitialModel simDraw simUpdate simHandler simTitle) : simulations) window
  = do
    return ()
    canvas <-
      UI.canvas
      # set UI.width  (width simConfig)
      # set UI.height (height simConfig)
      # set UI.style  [("background", "#bbb")]

    canvas # setAttribute "tabindex" "1"

    text          <- UI.p # set UI.text simTitle
    playButton    <- UI.button # set UI.class_ "play"
    restartButton <- UI.button # set UI.class_ "restart"

    buttonDiv     <- UI.div # set UI.children [playButton, restartButton] # set
      UI.class_
      "buttons"

    getBody window #+ [element text, element buttonDiv, element canvas]

    currentState    <- liftIO $ newIORef simInitialModel

    currentMousePos <- liftIO $ newIORef (0.0, 0.0)

    currentPause    <- liftIO $ newIORef False

    on UI.click playButton $ \_ -> do
      pause <- liftIO $ readIORef currentPause
      liftIO $ writeIORef currentPause (not pause)

    on UI.click restartButton $ \_ -> do
      liftIO $ writeIORef currentState simInitialModel

    handleEventsMultiple simConfig
                         currentState
                         currentMousePos
                         currentPause
                         (simHandler)
                         canvas

    animateMultiple currentState currentPause (simUpdate) (simDraw) canvas

    simulate simulations window