<commit_before>{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------
-- |
-- Copyright   : (C) 2014 <NAME>
-- License     : BSD3
--
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : portable
--
----------------------------------------------------------------------------

module Photon.Interface.Run (
    -- * Running photon sessions
    runPhoton
  ) where

import Control.Applicative
import Control.Concurrent.STM ( atomically )
import Control.Concurrent.STM.TVar ( TVar, modifyTVar, newTVarIO, readTVar
                                   , writeTVar )
import Control.Monad ( forM_ )
import Control.Monad.Free ( Free(..) )
import Control.Monad.Trans ( liftIO )
import Control.Monad.Trans.Either ( runEitherT )
import Control.Monad.Trans.Journal ( evalJournalT )
import Data.Traversable ( traverse )
import Data.List ( intercalate )
import Graphics.Rendering.OpenGL.Raw
import Graphics.UI.GLFW as GLFW
import Numeric.Natural ( Natural )
import Photon.Core.Entity ( Entity )
import Photon.Core.Light ( Light )
import Photon.Core.Loader ( Load(..) )
import Photon.Core.Material ( Material )
import Photon.Core.Mesh ( Mesh )
import Photon.Core.Projection ( Projection )
import Photon.Interface.Command ( Photon )
import qualified Photon.Interface.Command as GC ( PhotonCmd(..) )
import Photon.Interface.Event
import Photon.Interface.Shaders ( lightVS, lightFS )
import Photon.Render.Camera ( GPUCamera(..), gpuCamera )
import Photon.Render.GL.Shader ( ShaderType(..), Uniform, Uniformable )
import Photon.Render.Light ( GPULight(..), gpuLight )
import Photon.Render.Material ( GPUMaterial(..), gpuMaterial )
import Photon.Render.Mesh ( GPUMesh(..), gpuMesh )
import Photon.Render.Shader ( GPUProgram(..), gpuProgram )
import Photon.Utils.Log ( Log(..), LogCommitter(..), LogType(..), sinkLogs )
import Photon.Utils.TimePoint
import Prelude hiding ( Either(Left,Right) )

data PhotonDriver = PhotonDriver {
    drvRegisterMesh     :: Mesh -> IO GPUMesh
  , drvRegisterMaterial :: Material -> IO GPUMaterial
  , drvRegisterLight    :: Light -> IO GPULight
  , drvRegisterCamera   :: Projection -> Entity -> IO GPUCamera
  , drvLoadObject       :: (Load a) => String -> IO (Maybe a)
  , drvRenderMeshes     :: GPUMaterial -> [(GPUMesh,Entity)] -> IO ()
  , drvSwitchLightOn    :: GPULight -> Entity -> IO ()
  , drvLook             :: GPUCamera -> IO ()
  , drvLog              :: LogType -> String -> IO ()
  , drvTime             :: IO TimePoint
  }

-- |Helper function to show 'GLSL.Version' type, because they didn’t pick the
-- one from "Data.Version"…
showGLFWVersion :: Version -> String
showGLFWVersion (Version major minor rev) = intercalate "." $ map show [major,minor,rev]

-------------------------------------------------------------------------------
-- Run game

-- |Run a game session. This is the entry point of a photon-powered game. It
-- spawns a standalone window in windowed or fullscreen mode. If you want to
-- embed **photon** in a /GUI/ container, you shouldn’t use 'runPhoton'.
--
-- You’ll be asked for an event poller. This is optional; if you don’t want
-- any specific events, just use @return []@. If you do, you’ll be placed in
-- 'IO' so that you can do whatever you want, like socket-based communication
-- or anything 'IO'-related.
--
-- Nevertheless, **photon** does generate core events. You have to react to
-- them if you want your application to correctly behave. That’s done via an
-- /event handler/ which type is 'EventHandler u a', where 'u' is your event
-- type and 'a' your application.
--
-- The application runs in a special isolated monad, 'Photon'. That type gives
-- you everything you need for game-development. Feel free to read the 'Photon'
-- documentation for further understanding.
runPhoton :: Natural -- ^ Width of the window
        -> Natural -- ^ Height of the window
        -> Bool -- ^ Should the window be fullscreen?
        -> String -- ^ Title of the window
        -> IO [u] -- ^ User-spefic events poller
        -> EventHandler u a -- ^ Event handler
        -> (a -> Photon a) -- ^ Your application logic
        -> a -- ^ Initial application
        -> IO ()
runPhoton w h fullscreen title pollUserEvents eventHandler step app = do
    initiated <- GLFW.init
    if initiated then do
      glfwVersion <- fmap showGLFWVersion getVersion
      print (Log InfoLog CoreLog $ "GLFW " ++ glfwVersion ++ " initialized!")
      windowHint (WindowHint'ContextVersionMajor 3)
      windowHint (WindowHint'ContextVersionMinor 3)
      createWindow (fromIntegral w) (fromIntegral h) title Nothing Nothing >>= \win -> case win of
        Just window -> makeContextCurrent win >> runWithWindow w h fullscreen window pollUserEvents eventHandler step app
        -- TODO: display OpenGL information
        Nothing -> print (Log ErrorLog CoreLog "unable to create window :(")
      print (Log InfoLog CoreLog "bye!")
      terminate
      else do
        print (Log ErrorLog CoreLog "unable to init :(")

runWithWindow :: Natural -> Natural -> Bool -> Window -> IO [u] -> EventHandler u a -> (a -> Photon a) -> a -> IO ()
runWithWindow w h fullscreen window pollUserEvents eventHandler step initializedApp = do
    -- transaction variables
    events <- newTVarIO []
    mouseXY <- newTVarIO (0,0)

    -- callbacks
    setKeyCallback window (Just $ handleKey events)
    setMouseButtonCallback window (Just $ handleMouseButton events)
    setCursorPosCallback window (Just $ handleMouseMotion mouseXY events)
    setWindowCloseCallback window (Just $ handleWindowClose events)
    setWindowFocusCallback window (Just $ handleWindowFocus events)

    -- pre-process
    getCursorPos window >>= atomically . writeTVar mouseXY
    initGL

    -- game
    gdrv <- gameDriver w h fullscreen
    case gdrv of
      Nothing -> print (Log ErrorLog CoreLog "unable to create game driver")
      Just drv -> run_ drv events initializedApp
  where
    run_ drv events app = do
        -- poll user events then GLFW ones and sink shared events
        userEvs <- fmap (map UserEvent) pollUserEvents
        GLFW.pollEvents
        evs <- fmap (userEvs++) . atomically $ readTVar events <* writeTVar events []
        -- route events to game and interpret it; if it has to go on then simply loop
        traverse (interpretPhoton drv) (routeEvents (step app) evs) >>= maybe (return ()) endFrame
      where
        endFrame app' = do
          swapBuffers window
          run_ drv events app'
    routeEvents app evs = case evs of
      [] -> Just app
      (e:es) -> case eventHandler e of
        Just step' -> routeEvents (app >>= step') es
        Nothing -> Nothing

initGL :: IO ()
initGL = do
  glClearColor 0 0 0 0

-------------------------------------------------------------------------------
-- Photon interpreter
<commit_msg>run_ -> startFrame.<commit_after>{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------
-- |
-- Copyright   : (C) 2014 <NAME>
-- License     : BSD3
--
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : portable
--
----------------------------------------------------------------------------

module Photon.Interface.Run (
    -- * Running photon sessions
    runPhoton
  ) where

import Control.Applicative
import Control.Concurrent.STM ( atomically )
import Control.Concurrent.STM.TVar ( TVar, modifyTVar, newTVarIO, readTVar
                                   , writeTVar )
import Control.Monad ( forM_ )
import Control.Monad.Free ( Free(..) )
import Control.Monad.Trans ( liftIO )
import Control.Monad.Trans.Either ( runEitherT )
import Control.Monad.Trans.Journal ( evalJournalT )
import Data.Traversable ( traverse )
import Data.List ( intercalate )
import Graphics.Rendering.OpenGL.Raw
import Graphics.UI.GLFW as GLFW
import Numeric.Natural ( Natural )
import Photon.Core.Entity ( Entity )
import Photon.Core.Light ( Light )
import Photon.Core.Loader ( Load(..) )
import Photon.Core.Material ( Material )
import Photon.Core.Mesh ( Mesh )
import Photon.Core.Projection ( Projection )
import Photon.Interface.Command ( Photon )
import qualified Photon.Interface.Command as GC ( PhotonCmd(..) )
import Photon.Interface.Event
import Photon.Interface.Shaders ( lightVS, lightFS )
import Photon.Render.Camera ( GPUCamera(..), gpuCamera )
import Photon.Render.GL.Shader ( ShaderType(..), Uniform, Uniformable )
import Photon.Render.Light ( GPULight(..), gpuLight )
import Photon.Render.Material ( GPUMaterial(..), gpuMaterial )
import Photon.Render.Mesh ( GPUMesh(..), gpuMesh )
import Photon.Render.Shader ( GPUProgram(..), gpuProgram )
import Photon.Utils.Log ( Log(..), LogCommitter(..), LogType(..), sinkLogs )
import Photon.Utils.TimePoint
import Prelude hiding ( Either(Left,Right) )

data PhotonDriver = PhotonDriver {
    drvRegisterMesh     :: Mesh -> IO GPUMesh
  , drvRegisterMaterial :: Material -> IO GPUMaterial
  , drvRegisterLight    :: Light -> IO GPULight
  , drvRegisterCamera   :: Projection -> Entity -> IO GPUCamera
  , drvLoadObject       :: (Load a) => String -> IO (Maybe a)
  , drvRenderMeshes     :: GPUMaterial -> [(GPUMesh,Entity)] -> IO ()
  , drvSwitchLightOn    :: GPULight -> Entity -> IO ()
  , drvLook             :: GPUCamera -> IO ()
  , drvLog              :: LogType -> String -> IO ()
  , drvTime             :: IO TimePoint
  }

-- |Helper function to show 'GLSL.Version' type, because they didn’t pick the
-- one from "Data.Version"…
showGLFWVersion :: Version -> String
showGLFWVersion (Version major minor rev) = intercalate "." $ map show [major,minor,rev]

-------------------------------------------------------------------------------
-- Run game

-- |Run a game session. This is the entry point of a photon-powered game. It
-- spawns a standalone window in windowed or fullscreen mode. If you want to
-- embed **photon** in a /GUI/ container, you shouldn’t use 'runPhoton'.
--
-- You’ll be asked for an event poller. This is optional; if you don’t want
-- any specific events, just use @return []@. If you do, you’ll be placed in
-- 'IO' so that you can do whatever you want, like socket-based communication
-- or anything 'IO'-related.
--
-- Nevertheless, **photon** does generate core events. You have to react to
-- them if you want your application to correctly behave. That’s done via an
-- /event handler/ which type is 'EventHandler u a', where 'u' is your event
-- type and 'a' your application.
--
-- The application runs in a special isolated monad, 'Photon'. That type gives
-- you everything you need for game-development. Feel free to read the 'Photon'
-- documentation for further understanding.
runPhoton :: Natural -- ^ Width of the window
        -> Natural -- ^ Height of the window
        -> Bool -- ^ Should the window be fullscreen?
        -> String -- ^ Title of the window
        -> IO [u] -- ^ User-spefic events poller
        -> EventHandler u a -- ^ Event handler
        -> (a -> Photon a) -- ^ Your application logic
        -> a -- ^ Initial application
        -> IO ()
runPhoton w h fullscreen title pollUserEvents eventHandler step app = do
    initiated <- GLFW.init
    if initiated then do
      glfwVersion <- fmap showGLFWVersion getVersion
      print (Log InfoLog CoreLog $ "GLFW " ++ glfwVersion ++ " initialized!")
      windowHint (WindowHint'ContextVersionMajor 3)
      windowHint (WindowHint'ContextVersionMinor 3)
      createWindow (fromIntegral w) (fromIntegral h) title Nothing Nothing >>= \win -> case win of
        Just window -> makeContextCurrent win >> runWithWindow w h fullscreen window pollUserEvents eventHandler step app
        -- TODO: display OpenGL information
        Nothing -> print (Log ErrorLog CoreLog "unable to create window :(")
      print (Log InfoLog CoreLog "bye!")
      terminate
      else do
        print (Log ErrorLog CoreLog "unable to init :(")

runWithWindow :: Natural -> Natural -> Bool -> Window -> IO [u] -> EventHandler u a -> (a -> Photon a) -> a -> IO ()
runWithWindow w h fullscreen window pollUserEvents eventHandler step initializedApp = do
    -- transaction variables
    events <- newTVarIO []
    mouseXY <- newTVarIO (0,0)

    -- callbacks
    setKeyCallback window (Just $ handleKey events)
    setMouseButtonCallback window (Just $ handleMouseButton events)
    setCursorPosCallback window (Just $ handleMouseMotion mouseXY events)
    setWindowCloseCallback window (Just $ handleWindowClose events)
    setWindowFocusCallback window (Just $ handleWindowFocus events)

    -- pre-process
    getCursorPos window >>= atomically . writeTVar mouseXY
    initGL

    -- game
    gdrv <- gameDriver w h fullscreen
    case gdrv of
      Nothing -> print (Log ErrorLog CoreLog "unable to create game driver")
      Just drv -> startFrame drv events initializedApp
  where
    startFrame drv events app = do
        -- poll user events then GLFW ones and sink shared events
        userEvs <- fmap (map UserEvent) pollUserEvents
        GLFW.pollEvents
        evs <- fmap (userEvs++) . atomically $ readTVar events <* writeTVar events []
        -- route events to game and interpret it; if it has to go on then simply loop
        traverse (interpretPhoton drv) (routeEvents (step app) evs) >>= maybe (return ()) endFrame
      where
        endFrame app' = do
          swapBuffers window
          startFrame drv events app'
    routeEvents app evs = case evs of
      [] -> Just app
      (e:es) -> case eventHandler e of
        Just step' -> routeEvents (app >>= step') es
        Nothing -> Nothing

initGL :: IO ()
initGL = do
  glClearColor 0 0 0 0

-------------------------------------------------------------------------------
-- Photon interpreter

{'fraction_non_alphanumeric': 0.1454003778520564, 'fraction_numerical': 0.0018892602819357651, 'mean_word_length': 2.4728740852889226, 'pattern_counts': {'":': 0, '<': 27, '<?xml version=': 0, '>': 116, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2105334', 'n_tokens_mistral': 3837, 'n_tokens_neox': 3750, 'n_words': 1349}