<commit_before>{-# LANGUAGE FlexibleContexts, LambdaCase, RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
import Graphics.UI.GLFW.Pal
import Graphics.GL.Pal
import Graphics.VR.Pal

import Control.Monad
import Control.Monad.State
import Control.Monad.Reader
import Control.Lens.Extra
import Data.Map (Map)
import qualified Data.Map as Map
import System.Random

import Types
import CubeUniforms

import Physics.Bullet

data World = World
  { _wldPlayer :: !(Pose GLfloat)
  , _wldCubes  :: !(Map ObjectID Cube)
  }
makeLenses ''World

newWorld :: World
newWorld = World
    (Pose (V3 0 20 60) (axisAngle (V3 0 1 0) 0))
    mempty

planeM44 :: M44 GLfloat
planeM44 = transformationFromPose $ newPose 
  & posOrientation .~ axisAngle (V3 1 0 0) (-pi/2)

main :: IO ()
main = do

  let fov = 45
  
  VRPal{..} <- initVRPal "Bullet" []

  shader    <- createShaderProgram "test/shared/cube.vert" "test/shared/cube.frag"
  cubeGeo   <- cubeGeometry (1 :: V3 GLfloat) (V3 1 1 1)
  cubeShape <- makeShape cubeGeo shader :: IO (Shape Uniforms)

  planeGeo   <- planeGeometry 1000 (V3 0 0 1) (V3 0 1 0) 1
  planeShape <- makeShape planeGeo shader :: IO (Shape Uniforms)
  

  dynamicsWorld  <- createDynamicsWorld mempty
  _              <- addGroundPlane dynamicsWorld (CollisionObjectID 0) 0
  

  glEnable GL_DEPTH_TEST

  glClearColor 0 0 0.1 1


  void . flip runStateT newWorld $ do 
    boxShape <- createBoxShape (1 :: V3 GLfloat)
    forM_ [1..1000] $ \i -> do
      rigidBody <- addRigidBody dynamicsWorld (CollisionObjectID i) boxShape mempty 
        { rbPosition = V3 0 20 0
        , rbRotation = Quaternion 0.5 (V3 0 1 1)
        }
      wldCubes . at (fromIntegral i) ?= Cube
        { _cubBody = rigidBody
        , _cubColor = V4 1 0 1 1
        }
    whileWindow gpWindow $ do
      projMat <- getWindowProjection gpWindow fov 0.1 1000
      viewMat <- viewMatrixFromPose <$> use wldPlayer
      (x,y,w,h) <- getWindowViewport gpWindow
      glViewport x y w h
      
      processEvents gpEvents $ \e -> do
        closeOnEscape gpWindow e
        case e of
          (MouseButton _ _ _) -> do 

            playerPose <- use wldPlayer
            cursorRay  <- cursorPosToWorldRay gpWindow projMat playerPose

            mBodyID <- mapM (getCollisionObjectID . rrCollisionObject) =<< rayTestClosest dynamicsWorld cursorRay
<commit_msg>Wibble<commit_after>{-# LANGUAGE FlexibleContexts, LambdaCase, RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
import Graphics.UI.GLFW.Pal
import Graphics.GL.Pal
import Graphics.VR.Pal

import Control.Monad
import Control.Monad.State
import Control.Monad.Reader
import Control.Lens.Extra
import Data.Map (Map)
import qualified Data.Map as Map
import System.Random

import Types
import CubeUniforms

import Physics.Bullet

data World = World
  { _wldPlayer :: !(Pose GLfloat)
  , _wldCubes  :: !(Map ObjectID Cube)
  }
makeLenses ''World

newWorld :: World
newWorld = World
    (Pose (V3 0 20 60) (axisAngle (V3 0 1 0) 0))
    mempty

planeM44 :: M44 GLfloat
planeM44 = transformationFromPose $ newPose 
  & posOrientation .~ axisAngle (V3 1 0 0) (-pi/2)

main :: IO ()
main = do

  let fov = 45
  
  VRPal{..} <- initVRPal "Bullet" []

  shader    <- createShaderProgram "test/shared/cube.vert" "test/shared/cube.frag"
  cubeGeo   <- cubeGeometry (1 :: V3 GLfloat) (V3 1 1 1)
  cubeShape <- makeShape cubeGeo shader :: IO (Shape Uniforms)

  planeGeo   <- planeGeometry 1000 (V3 0 0 1) (V3 0 1 0) 1
  planeShape <- makeShape planeGeo shader :: IO (Shape Uniforms)
  

  dynamicsWorld  <- createDynamicsWorld mempty
  _              <- addGroundPlane dynamicsWorld (CollisionObjectID 0) 0
  

  glEnable GL_DEPTH_TEST

  glClearColor 0 0 0.1 1


  void . flip runStateT newWorld $ do 
    boxShape <- createBoxShape (1 :: V3 GLfloat)
    forM_ [1..1000] $ \i -> do
      rigidBody <- addRigidBody dynamicsWorld (CollisionObjectID i) boxShape mempty 
        { rbPosition = V3 0 20 0
        , rbRotation = Quaternion 0.5 (V3 0 1 1)
        }
      wldCubes . at (fromIntegral i) ?= Cube
        { _cubBody = rigidBody
        , _cubColor = V4 1 0 1 1
        }
    whileWindow gpWindow $ do
      projMat <- getWindowProjection gpWindow fov 0.1 1000
      viewMat <- viewMatrixFromPose <$> use wldPlayer
      (x,y,w,h) <- getWindowViewport gpWindow
      glViewport x y w h
      
      processEvents gpEvents $ \e -> do
        closeOnEscape gpWindow e
        case e of
          onMouseDown e $ \_ -> do

            playerPose <- use wldPlayer
            cursorRay  <- cursorPosToWorldRay gpWindow projMat playerPose

            mBodyID <- mapM (getCollisionObjectID . rrCollisionObject) =<< rayTestClosest dynamicsWorld cursorRay

{'fraction_non_alphanumeric': 0.09034732580438952, 'fraction_numerical': 0.03366716386106968, 'mean_word_length': 2.7224425059476607, 'pattern_counts': {'":': 0, '<': 41, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6365485', 'n_tokens_mistral': 1798, 'n_tokens_neox': 1583, 'n_words': 473}